Instead of a long Case?

[Risky Dave]

Hi,

I have a Case statement that seems to me to be ridiculously long:
Do
Select Case rSearch.Value
Case sName
ScreenUpdating = False
If rSearch.Offset(6, 0) <> "" Then
Sheets("blank").Range("c46") = rSearch.Offset(6, 0).Value
End If
If rSearch.Offset(12, 0) <> "" Then
Sheets("blank").Range("c47") = rSearch.Offset(12, 0).Value
End If

'<about 120 more IF statements all pretty much the same as
these, only the source and target offset addresses change>

Sheets("blank").Visible = True
Sheets("blank").Select
Range("B1:Z69").Select
Range("Y69").Activate
ActiveSheet.PageSetup.PrintArea = "$B$1:$Z$69"
With ActiveSheet.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Range("C5").Select

ScreenUpdating = True
Exit Do
Case ""
MsgBox ("please enter a valid name")
Exit Do
Case Else
Set rSearch = rSearch.Offset(0, 1)
iCtr = iCtr + 1
End Select
Loop


A simple question, is there a more efficient way of doing this? It's not
that the code is slow, just seems to me to not be vary concise.

TIA

Dave

 

[Rick Rothstein]

Please describe "all pretty much the same" for us. Is the receiving cell's
offset *always* 6 greater than the previous If..Then block and, if so, is
the source cell's offset always 1 greater than the previous If..Then?

 

[Risky Dave]

Rick,

Thanks for the prompt reply.

Unfortunately, it's not quite that simple! The source offset value and the
receiving offset value are not regular and neither are the cell addresses on
the receiving sheet. the only constant is that they are all larger than the
values in the previous IF statement.

Hope this helps.

Dave

 

[Rick Rothstein]

Too bad they are not regularly spaced... the coding would have been much
simpler. Here is some (untested) code that should do what you want (just
complete the two lists where indicated)...

' Put these Dim statements with your other Dim statements
Dim X As Long
Dim SearchOffsets As Variant
Dim BlankShtAddr As Variant

' This code replaces your 120+ individual If..Then blocks
SearchOffsets = Array(6, 7, 10, <<list rest of offsets>>)
BlankShtAddr = Array("C46", "C47", "C50", <<list rest of addresses>>)
For X = LBound(SearchOffsets) To UBound(SearchOffsets)
Sheets("blank").Range(BlankSheetAddresses(X)) = _
rSearch.Offset(SearchOffsets(X), 0).Value
Next

 

[Risky Dave]

Rick,

Thanks.

Dave

Too bad they are not regularly spaced... the coding would have been much
simpler. Here is some (untested) code that should do what you want (just
complete the two lists where indicated)...

' Put these Dim statements with your other Dim statements
Dim X As Long
Dim SearchOffsets As Variant
Dim BlankShtAddr As Variant

' This code replaces your 120+ individual If..Then blocks
SearchOffsets = Array(6, 7, 10, <<list rest of offsets>>)
BlankShtAddr = Array("C46", "C47", "C50", <<list rest of addresses>>)
For X = LBound(SearchOffsets) To UBound(SearchOffsets)
Sheets("blank").Range(BlankSheetAddresses(X)) = _
rSearch.Offset(SearchOffsets(X), 0).Value
Next