A macro to check range and then check another range if falset-then

  • Thread starter Thread starter Jim A
  • Start date Start date
J

Jim A

Hi – I have been trying to work out a macro.
I am looking for a macro that will check 2 things....then do something.
The first is if a particular cell contains a given value. Lets say
Sheets("sheet1").Range("D3") should equal "Year 1" if true.

Next is if a range of cell values in are blank,
Sheets("Sheet1").Range("D6:G48") should be blank.
If both these are true then I want the macro to copy a range of cells from
Sheets("Sheet2").Range("AR5:AR47") to Sheets("Sheet1").Range("D6:D48").
If false then move on to the next range of cells (go on to “Year 2†and its
corresponding range of cells) and perform this same check until True.

Conditions are:
-I have five distinct ranges of cells starting with "Year 1" going through
"Year 5" on Sheet1.
-Sheets("Sheet1").Range("D6:G48") only belongs to Year 1. The label “Year
1†is in cell D3.
-Sheets("Sheet1").Range(""I6:L48") belongs to Year 2. The label “Year 2†is
in cell I3.
-And so on...through Year 5.
-I have the Years listed in a combo box on Sheet2 (where I also have a
button that activates this macro).
I have tried this code, BUT I can NOT get the macro beyond simply looking at
“Year 1.†I am to unfamiliar with Looping and Next to make it work here.

If WorksheetFunction.CountA(Sheets("Credit History").Range("D6:G48")) = 0 _
And UCase(Sheets("Credit History").Range("D3")) = UCase("Year 1") Then

Sheets("Credit History").Range("D6:D48").Value = _
Range("AR5:AR47").Value

Thanks for your help – Jim Ayers
 
Hi Jim

You seem to have change your references for the first posting.
Adjust the following to suit your Sheet names and references accordingly.
From waht I read, you need to Offset by 5 Columns each time the Year is
increased.

The following (untested code) should get you started.

Sub test()
Dim wss As Worksheet, wsd As Worksheet
Dim i As Long, j As Long
j = 0
Set wss = ThisWorkbook.Sheets("Sheet1") '< == Amend
Set wsd = ThisWorkbook.Sheets("Sheet2") '< == Amend

For i = 1 To 5

If WorksheetFunction.CountA(wss.Range("D6:G48").Offset(, j)) = 0 _
And UCase(wss.Range("D3").Offset(, j)) = UCase("Year 1") Then
wss.Range("D6:D48").Offset(, j).Copy _
wsd.Range("AR5:AR47").Offset(, j)
Exit Sub
Else
j = j + 5
End If

Next i

End Sub
 
Back
Top