VBA loop through range on one sheet, paste values from range into labels on second sheet

[dkjonesau]

Hi all,

After playing with this for a while I'm a bit beaten and asking for help.

I have a sheet with an entry list up to 200 entries long.

I need to loop through the range B6:M200 on Sheet1 copying two rows at a time, and pasting only some of the cells into cells on a second sheet - Sheet2.

As the second sheet is a label, the fields from Sheet1 which are in rows are dispersed in field locations in Sheet2.

eg. for the first two rows B6:M7

Sheet1 B6 pastes (value only) to Sheet2 D14
Sheet1 M6 pastes (value only) to Sheet2 C13
Sheet1 B7 pastes to (value only) Sheet2 D37
Sheet1 M7 pastes to (value only) Sheet2 C33

I'll then call a routine to print Sheet2 as a page.

Loop on Sheet1 to next two rows
Sheet1 B8 pastes to Sheet2 D14 (overwriting previous value)
Sheet1 M8 pastes to Sheet2 C13 "
Sheet1 B9 pastes to Sheet2 D37 "
Sheet1 M9 pastes to Sheet2 C33 "

the process repeats until the last row containing data is found on Sheet1

I've tried a few different ways but not that allow me to spread the data around on the Sheet2 in the locations it's needed. (I've just realised I should have searched for a mailing label VBA routine...

Any assistance appreciated.

Thanks

Dave

 

[Trevor_S]

This should do it. You'll need to add your printing routine where indicated:

Sub Macro()
myRow = 6
Do until Sheets("Sheet1").Range("B" & myRow).Value =""
  Sheets("Sheet2").Range("D14").Value = Sheets("Sheet1').Range("B" & myRow).Value
  Sheets("Sheet2").Range("C13").Value = Sheets("Sheet1').Range("M" & myRow).Value
  Sheets("Sheet2").Range("D37").Value = Sheets("Sheet1').Range("B" & myRow + 1).Value
  Sheets("Sheet2").Range("C33").Value = Sheets("Sheet1').Range("B" & myRow + 1).Value


  ' call your printing routine
  
  myRow = myRow + 2
Loop
End Sub

 

[dkjonesau]

This should do it. You'll need to add your printing routine where indicated:

Sub Macro()
myRow = 6
Do until Sheets("Sheet1").Range("B" & myRow).Value =""[COLOR=#ff0000]
  Sheets("Sheet2").Range("D14").Value = Sheets("Sheet1').Range("B" & myRow).Value
  Sheets("Sheet2").Range("C13").Value = Sheets("Sheet1').Range("M" & myRow).Value
  Sheets("Sheet2").Range("D37").Value = Sheets("Sheet1').Range("B" & myRow + 1).Value
  Sheets("Sheet2").Range("C33").Value = Sheets("Sheet1').Range("B" & myRow + 1).Value[/COLOR]


  ' call your printing routine
  
  myRow = myRow + 2
Loop
End Sub

Area shown appears red and compiles with a syntax error. Thoughts?

Thanks for the help.

Dave

 

[dkjonesau]

Der. Answer right in front of me. Thinking it was part of the referencing I wasn't familiar with but it's the ' not " after Sheet names in the second section of each line. You were just checking I was awake, I think it the line teachers used to use

Dave

 

[Trevor_S]

Sorry, my mistake, blame my phone keypad! Had just typed it into my computer to test, but as I'd typed it correctly that time, hadn't seen the problem!!

 

[dkjonesau]

Sorry, my mistake, blame my phone keypad! Had just typed it into my computer to test, but as I'd typed it correctly that time, hadn't seen the problem!!

No problem. I'm wondering if you can assist with a modification to your code for a different routine.

Once I've generated all the labels, I want a second routine where I autofilter the information on Sheet1 to a specific line or couple of lines to generate individual labels.

The code I have thus far is below. The autofilter from entered numbers is working fine. Because the row number returned in the filter can't be referenced to take the value from for the label, I though I could use the header row from the autofilter then direct your code to take a value from an offset row from the header row. That doesn't appear to be the case, or I'm not using the offset correctly.

If there's a better way to do it I'm all ears. I'll keep playing with it.

Thanks,

Dave


Sub Bibs_print_by_athlete_number()
Dim LR As Long
On Error GoTo NotValidInput
Dim athlete1 As Integer
Dim athlete2 As Integer

shooter1 = InputBox("Enter athlete number for required bib :")


shooter2 = InputBox("Enter athlete number for second required bib or leave blank :")

Sheets("Entry List").Select
Application.ScreenUpdating = True
Range("B5", "m200").AutoFilter Field:=1, Criteria1:="=" & shooter1, Operator:=xlOr, Criteria2:="=" & shooter2
LR = Range("C" & Rows.Count).End(xlUp).Row
Sheets("Bibs").Range("D14").Value = Sheets("Entry List").Range("B5").Offset(1, 0).Value
Sheets("Bibs").Range("C10").Value = Sheets("Entry List").Range("M5").Offset(1, 0).Value
Sheets("Bibs").Range("D37").Value = Sheets("Entry List").Range("B5").Offset(2, 0).Value
Sheets("Bibs").Range("C33").Value = Sheets("Entry List").Range("M5").Offset(2, 0).Value
Sheets("Bibs").Select

 

[dkjonesau]

Hmmm. Getting better at this. Solved my second query myself!

What ended up working was

Sheets("Bibs").Range("D14").Value = Sheets("Entry List").UsedRange.SpecialCells(xlCellTypeVisible).Areas(2).Columns(1).Cells(1, 1).Value
Sheets("Bibs").Range("C10").Value = Sheets("Entry List").UsedRange.SpecialCells(xlCellTypeVisible).Areas(2).Columns(12).Cells(1, 1).Value
Sheets("Bibs").Range("D37").Value = Sheets("Entry List").UsedRange.SpecialCells(xlCellTypeVisible).Areas(3).Columns(1).Cells(1, 1).Value
Sheets("Bibs").Range("C33").Value = Sheets("Entry List").UsedRange.SpecialCells(xlCellTypeVisible).Areas(3).Columns(12).Cells(1, 1).Value

 

[Trevor_S]

I wouldn't use filter. I'd use match to find the row numbers of the entries:

shooter1 = InputBox("Enter athlete number for required bib :")
sRow1 = Application.WorksheetFunction.Match(shooter1, Sheets("Entry List").Range("B:B", 0)


shooter2 = InputBox("Enter athlete number for second required bib or leave blank :")
If shooter2 = "" Then
  sRow2 = 'Enter some default value here
Else
  sRow2 = Application.WorksheetFunction.Match(shooter2, Sheets("Entry List").Range("B:B", 0)
End If

Then use the same macro as before, substituting the sheet names and myRow and myRow + 1 for sRow1 and sRow2.

Note the line for sRow2 ...you'll need to have some default set here being a line number of a blank row for if you're only printing one at a time.

 

[Trevor_S]

But, if your way works too, that's good!

 

[dkjonesau]

If it aint broke...



DJ