vba Double for each Loop combining task

[malleshg24]

:think:Hi Team,

I have two for each loop , is it possible to combine it. to shorten the code. :help



For Each ws in wbk1.Worksheets
ws.Columns("A").NumberFormat = "General"
ws.Columns("A").TextToColumns , xlDelimited, , , , , False, False, False
Next ws


For Each ws In wbk1.Worksheets
Select Case ws.Name
Case "Sheet1", "Sheet2", "Sheet4", "Sheet6"
ws.Range("B1").EntireColumn.Insert
ws.Range("B1").Value = "Historic/New"
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Range("B2:B" & lr).Formula = "=IF(ISERROR(VLOOKUP(A2,'[" & wbk2.Name & "]Sheet1'!$A$1:$A$10000,1,False)),""New"",""Historic"")"
End Select
Next ws

[Bob Phillips]

For Each ws In wbk1.Worksheets

With ws

With .Columns("A")

.NumberFormat = "General"
.TextToColumns , xlDelimited, , , , , False, False, False
End With

Select Case .Name
Case "Sheet1", "Sheet2", "Sheet4", "Sheet6"
.Range("B1").EntireColumn.Insert
.Range("B1").Value = "Historic/New"
lr = .Cells(Rows.Count, "A").End(xlUp).Row
.Range("B2:B" & lr).Formula = "=IF(ISERROR(VLOOKUP(A2,'[" & wbk2.Name & "]Sheet1'!$A$1:$A$10000,1,False)),""New"",""Historic"")"
End Select
End With
Next ws