Excel VBA Loop & Variable Reference
Hi - Thanks Tom Ogilvy for the code! And the link to the tutorial.
It's making more sense now. Now I'd like to loop through the code so that it will run for each cell in a column that has data. I'd also like it to check row 2 in several worksheets. Sub MarkDate() Dim dt As Long Dim desc As String Dim rng As Range, rng1 As Range, res As Variant Dim cell As Range Dim cl As Integer 'I need the following to execute for every cell 'in column B with a value and not just for cell B1 Set rng = Worksheets("WorksheetA").Range("B1") dt = rng.Value desc = rng.Offset(0, -1).Value cl = rng.Offset(0, 1).Value 'Is it possible to have the code search Row 2 in several sheets 'all in one bit of code? Or would it be better to write this 'for each worksheet I want checked (WorksheetB, WorksheetC, ...) Set rng1 = Worksheets("WorksheetB").Rows(2).Cells res = Application.Match(dt, rng1, 0) If Not IsError(res) Then Set cell = rng1(1, res) cell.EntireColumn.Interior.ColorIndex = cl cell.Offset(3, 0).Value = desc End If End Sub |
Excel VBA Loop & Variable Reference
Hooray! I got it, I got it! Check this out:
Sub MarkDate1() Dim dt As Long Dim desc As String, wkName As String Dim rng As Range, Lc As Range, rng1 As Range, res As Variant Dim i As Integer, clr As Integer Dim cell As Range For i = 2 To Worksheets("Holidays").Range("C65536").Value + 1 'cell C65536 has the formula =COUNTA(C2:C65535) 'Column A = holiday name, Column B = Month (=IF(C2<"",TEXT(C2,"mmmm"),"")) 'Column C = Date, Column D = color index Set rng = Worksheets("Holidays").Columns(3).Cells Set Lc = rng(i) dt = Lc.Value desc = Lc.Offset(0, -2).Value clr = Lc.Offset(0, 1).Value wkName = Lc.Offset(0, -1).Value Set rng1 = Worksheets(wkName).Rows(1).Cells res = Application.Match(dt, rng1, 0) If Not IsError(res) Then Set cell = rng1(1, res) cell.EntireColumn.Interior.ColorIndex = clr cell.Offset(3, 0).Value = desc End If Next i End Sub |
All times are GMT +1. The time now is 06:27 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com