CODEWITHSUNDEEP
excelvbaloops
John Liu
John Liu

Reputation: 37

vba compare values of same address across multiple sheets

I have a workbook containing approximately 100 worksheets.

I want to compare values of the same address (e.g. .cell(i,10)) across multiple worksheets (5th to 100th worksheet in my workbook).

If thisworkbook.sheets(18).cells(i,10).value was the greatest among all worksheets, then copy thisworkbook.sheets(18).cells(i,10).value to cells(LR+1,1) of sheets(1) (where i and LR were variables, LR was the last row of sheets(1)).

If .cells(i,10) of particular sheet was blank or contained errors, skip .cells(i,10) of that sheet from comparison.

I couldn't get the correct syntax of the code I needed. Can anybody help?

below were modified from original codes to fit the task for 4 worksheets (5,6,7,8):

Dim ws as worksheet, ws5 as worksheet, ws6 as worksheet, ws7 as worksheet, ws8 as worksheet
set ws = thisworkbook.worksheets("MAIN")
set ws5 = thisworkbook.worksheets("five")
set ws6 = thisworkbook.worksheets("six")
set ws7 = thisworkbook.worksheets("seven")
set ws8 = thisworkbook.worksheets("eight")

dim i as long, LR as long
LR = ws.cells(ws.rows.count,1).end(xlup).row

with worksheetfunction
For i = 2 to 5000

if ws5.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws5.cells(i,10).value
end if
if ws6.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws6.cells(i,10).value
end if
if ws7.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws7.cells(i,10).value
end if
if ws8.cells(i,10) = .max(ws5.cells(i,10),ws6.cells(i,10),ws7.cells(i,10),ws8.cells(i,10)) then
ws.cells(lr+1).value = ws8.cells(i,10).value
end if

next i
end with

end sub

to follow up Tim's solution below I post the code I needed.

Sub Tester()

Dim i As Long, v, mx, r, s, wb As Workbook, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MAIN")

Set wb = ThisWorkbook

For s = 2 To 1000
r = "C" & s

For i = 2 To wb.Worksheets.Count
    v = wb.Worksheets(i).Range(r).Value
    If IsNumeric(v) And Len(v) > 0 Then
        mx = IIf(Len(mx) = 0, v, IIf(v > mx, v, mx))
    End If
Next i

ws.Cells(s, 1).Value = IIf(Len(mx) > 0, mx, "No values")

Debug.Print IIf(Len(mx) > 0, mx, "No values")
mx = False

Next s
End Sub

Upvotes: 0

Views: 483

Answers (2)

John Liu
John Liu

Reputation: 37

Sub Tester()

Dim i As Long, v, mx, r, s, wb As Workbook, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("MAIN")

Set wb = ThisWorkbook

For s = 2 To 1000
r = "C" & s

For i = 2 To wb.Worksheets.Count
v = wb.Worksheets(i).Range(r).Value
If IsNumeric(v) And Len(v) > 0 Then
    mx = IIf(Len(mx) = 0, v, IIf(v > mx, v, mx))
End If
Next i

ws.Cells(s, 1).Value = IIf(Len(mx) > 0, mx, "No values")

Debug.Print IIf(Len(mx) > 0, mx, "No values")
mx = False

Next s
End Sub

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166456

You can use a loop:

Sub Tester()
    
    Dim i As Long, v, mx, r, wb As Workbook
    
    Set wb = ThisWorkbook
    r = "A1"
   
    For i = 2 To wb.Worksheets.Count
        v = wb.Worksheets(i).Range(r).Value
        If IsNumeric(v) And Len(v) > 0 Then
            mx = IIf(Len(mx) = 0, v, IIf(v > mx, v, mx))
        End If
    Next i
    
    Debug.Print IIf(Len(mx) > 0, mx, "No values")

End Sub

Upvotes: 1

Related Questions