*********this is my VBA code. I have tried many different solutions but none see
ID: 3773322 • Letter: #
Question
*********this is my VBA code. I have tried many different solutions but none seem to work. any help would be appreciated***********
Sub MultiDimensiionArray1()
'array for sheet one and sheet two
Dim myArraySheet1(0 To 3, 0 To 4) As Variant
Dim myArraySheet2(0 To 5, 0 To 4) As Variant
Dim i As Long, j As Long ' dimension counter for for sheet one
Dim Dimension1 As Long, Dimension2 As Long ' dimension counter for for sheet one
'number of rows in sheet one
Dim x As Integer, NumRows As Integer
Sheet1.Activate
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
'Dim RangeVariableSheet1 As Variant
' Set numrows = number of rows of data.
' NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
'select range
'RangeVariableSheet1 = Range("A2:E2").Select
'ActiveCell.Offset(1, 0).Select
'store everything on sheet one in array
For i = LBound(myArraySheet1, 1) To UBound(myArraySheet1, 1) 'here am saying give me lower & upper bound of myArraySheet1 array dimension one
For j = LBound(myArraySheet1, 2) To UBound(myArraySheet1, 2) ' give me lower & upper bound of myArraySheet1 array dimension two
myArraySheet1(i, j) = Range("A2").Offset(i, j).Value
Next j
Next i
'store everything on sheet two in array
Sheet2.Activate
For Dimension1 = LBound(myArraySheet2, 1) To UBound(myArraySheet2, 1)
For Dimension2 = LBound(myArraySheet2, 2) To UBound(myArraySheet2, 2)
myArraySheet2(Dimension1, Dimension2) = Range("A2").Offset(Dimension1, Dimension2).Value
Next Dimension2
Next Dimension1
'READ FROM ARRAY/OR DISPLAY THE RESULT
Sheet1.Activate
' Select sheet one cell G2
Range("G2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
For i = LBound(myArraySheet1, 1) To UBound(myArraySheet1, 1)
For j = LBound(myArraySheet1, 2) To UBound(myArraySheet1, 2)
For Dimension1 = LBound(myArraySheet2, 1) To UBound(myArraySheet2, 1) 'here am saying give me lower & upper bound of topfilms array dimension one
For Dimension2 = LBound(myArraySheet2, 2) To UBound(myArraySheet2, 2) ' give me lower & upper bound of TopFilms array dimension two
'if sheet one row equal to sheet two row execute the below code
If myArraySheet1(i, j) = myArraySheet2(Dimension1, Dimension2) Then
ActiveCell.Value = "YES IT IS DUPE AND NOT RESOLVED"
ActiveCell.Interior.ColorIndex = 4
ActiveCell.Font.ColorIndex = 2
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Value = "Brand New"
ActiveCell.Interior.ColorIndex = 3
ActiveCell.Font.ColorIndex = 2
End If
Next Dimension2
Next Dimension1
Next j
Next i
Next
End Sub
Explanation / Answer
Sub Compare()
'
' Macro1 Macro
'
' compare two different worksheets in the active workbook
CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub
Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet
Dim r As Long, c As Integer, m As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
With ws1.UsedRange
lr1 = .Rows.Count
lc1 = .Columns.Count
End With
With ws2.UsedRange
lr2 = .Rows.Count
lc2 = .Columns.Count
End With
maxR = lr1
maxC = lc1
If maxR < lr2 Then maxR = lr2
If maxC < lc2 Then maxC = lc2
For c = 1 To maxC
For i = 2 To lr1
For r = 2 To lr2
cf1 = ""
cf2 = ""
On Error Resume Next
cf1 = ws1.Cells(i, c).FormulaLocal
cf2 = ws2.Cells(r, c).FormulaLocal
On Error GoTo 0
If cf1 = cf2 Then
ws1.Cells(i,maxC). Value = "YES IT IS DUPE AND NOT RESOLVED"
ws1.Cells(i, maxC).Interior.ColorIndex = 2
Selection.Font.Bold = True
End If
Else
ws1.Cells(i,maxC). Value = "Brand New"
ws1.Cells(i, maxC).Interior.ColorIndex = 8
Selection.Font.Bold = True
End Else
Next r
Next i
Next c
End sub
Related Questions
Navigate
Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.