0
votes

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
2
we can help with your code if you edit your post and give a minimal reproducible example example of your code.Scott Craner
@ScottCraner, hello. Please see my edited post. Thank you.John Liu

2 Answers

1
votes

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
0
votes
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