loop to find integers and decimals and pass found row to bookmark code.

**beenbee** · 02-17-2014, 06:58 AM

Hi All,
I have posted this before however no one posted back, maybe due to the stupidly unwhieldyness of the code I have so far.
I am attempting to serach a column of data in a workbook (this column displays decimals up to 1dp/v.important). I want to be able to search the column and every time an integer or decimal is found, run a code that populates bookmarks with the data found in the rame row numbers as the search returns when a number or decimal is found. To add another level to the confusion I also would if possible like for if there is more that one decimal and they =< 1 then they add 2spec numbers to the same sheet.
What I am trying to do is create a pallet marker sheet which is populated with data from my delivery note.
The code which I have written is a huge if statement;
I don't believe its the best way to do it, but my knowledge stops here really. Any help or advice would be great
The limitations of my current code is that I have had to scale back the amount of numbers I can check to 9 as I butted up against the 1000line limit for VBE.

Sub Pallet_Marker()
Dim wrdApp As Word.Application
Dim strTemplateName As String
Dim aCell As Range
For Each aCell In Range("I16:I35")
If aCell.Value <> Int(aCell.Value) Then
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
strTemplateName = "C:\Documents and Settings\bethan\My Documents\Pallet Markers\1.dot"
Set wrdDoc = wrdApp.Documents.Add(strTemplateName)
Application.ScreenUpdating = False
 With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D" & aCell.Row).Value
 .Bookmarks("SpecNo").Range.Text = Range("B" & aCell.Row).Value
 .Bookmarks("Qty").Range.Text = Range("C" & aCell.Row).Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A" & aCell.Row).Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
End With
MsgBox "Decimals"
Exit For
End If
Next
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
strTemplateName = "C:\Documents and Settings\bethan\My Documents\Pallet Markers\1.dot"
Set wrdDoc = wrdApp.Documents.Add(strTemplateName)
Application.ScreenUpdating = False

' 1 pal 1 item
If Range("I16").Value = 1 And Range("I17") = "" Then
 With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D16").Value
 .Bookmarks("SpecNo").Range.Text = Range("B16").Value
 .Bookmarks("Qty").Range.Text = Range("C16").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A16").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
 End With
 ' 1 pal + 1 pal 2 dif items on same sheet
 ElseIf Range("I16").Value = 1 And Range("I17").Value = 1 And Range("I18").Value = "" Then
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D16").Value
 .Bookmarks("SpecNo").Range.Text = Range("B16").Value
 .Bookmarks("Qty").Range.Text = Range("C16").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A16").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
.Bookmarks("CustName2").Range.Text = Range("C8").Value
.Bookmarks("Ref2").Range.Text = Range("D17").Value
.Bookmarks("SpecNo2").Range.Text = Range("B17").Value
.Bookmarks("Qty2").Range.Text = Range("C17").Value
.Bookmarks("RCLon2").Range.Text = Range("J8").Value
.Bookmarks("Custon2").Range.Text = Range("A17").Value
.Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
End With
' 2 pal 1 item same sheet
ElseIf Range("I16").Value > 1 And Range("C17").Value = "" Then
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D16").Value
 .Bookmarks("SpecNo").Range.Text = Range("B16").Value
 .Bookmarks("Qty").Range.Text = Range("C16").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A16").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
.Bookmarks("CustName2").Range.Text = Range("C8").Value
.Bookmarks("Ref2").Range.Text = Range("D16").Value
.Bookmarks("SpecNo2").Range.Text = Range("B16").Value
.Bookmarks("Qty2").Range.Text = Range("C16").Value
.Bookmarks("RCLon2").Range.Text = Range("J8").Value
.Bookmarks("Custon2").Range.Text = Range("A16").Value
.Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
 End With
' 2 pal of 1 item and 1 pal of another item dif sheets
ElseIf Range("I16").Value > 1 And Range("B17").Value <> Range("B16").Value And Range("I17").Value >= 1 And Range("I18").Value = "" Then
 With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D16").Value
 .Bookmarks("SpecNo").Range.Text = Range("B16").Value
 .Bookmarks("Qty").Range.Text = Range("C16").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A16").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
.Bookmarks("CustName2").Range.Text = Range("C8").Value
.Bookmarks("Ref2").Range.Text = Range("D16").Value
.Bookmarks("SpecNo2").Range.Text = Range("B16").Value
.Bookmarks("Qty2").Range.Text = Range("C16").Value
.Bookmarks("RCLon2").Range.Text = Range("J8").Value
.Bookmarks("Custon2").Range.Text = Range("A16").Value
.Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
End With
 Set wrdApp = CreateObject("Word.Application")
 wrdApp.Visible = True
 strTemplateName = "C:\Documents and Settings\bethan\My Documents\Pallet Markers\1.dot"
 Set wrdDoc = wrdApp.Documents.Add(strTemplateName)
 Application.ScreenUpdating = False
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D17").Value
 .Bookmarks("SpecNo").Range.Text = Range("B17").Value
 .Bookmarks("Qty").Range.Text = Range("C17").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A17").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
End With
' 1 pal of 1st item + 2+ pals of 2nd item, 2 items on seperate sheets
ElseIf Range("I16").Value = 1 And Range("B17").Value <> Range("B16").Value And Range("I17").Value > 1 And Range("I18").Value = "" Then
 With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D16").Value
 .Bookmarks("SpecNo").Range.Text = Range("B16").Value
 .Bookmarks("Qty").Range.Text = Range("C16").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A16").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
End With
 Set wrdApp = CreateObject("Word.Application")
 wrdApp.Visible = True
 strTemplateName = "C:\Documents and Settings\bethan\My Documents\Pallet Markers\1.dot"
 Set wrdDoc = wrdApp.Documents.Add(strTemplateName)
 Application.ScreenUpdating = False
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D17").Value
 .Bookmarks("SpecNo").Range.Text = Range("B17").Value
 .Bookmarks("Qty").Range.Text = Range("C17").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A17").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
 .Bookmarks("CustName2").Range.Text = Range("C8").Value
.Bookmarks("Ref2").Range.Text = Range("D17").Value
.Bookmarks("SpecNo2").Range.Text = Range("B17").Value
.Bookmarks("Qty2").Range.Text = Range("C17").Value
.Bookmarks("RCLon2").Range.Text = Range("J8").Value
.Bookmarks("Custon2").Range.Text = Range("A17").Value
.Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
End With
'  2+pal of 1 item, 1 pal of 2nd, 1pal of 3rd. 3sheets
ElseIf Range("I16").Value >= 1 And Range("I17").Value >= 1 And Range("I18").Value >= 1 And Range("I19").Value = "" Then
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D16").Value
 .Bookmarks("SpecNo").Range.Text = Range("B16").Value
 .Bookmarks("Qty").Range.Text = Range("C16").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A16").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
.Bookmarks("CustName2").Range.Text = Range("C8").Value
.Bookmarks("Ref2").Range.Text = Range("D16").Value
.Bookmarks("SpecNo2").Range.Text = Range("B16").Value
.Bookmarks("Qty2").Range.Text = Range("C16").Value
.Bookmarks("RCLon2").Range.Text = Range("J8").Value
.Bookmarks("Custon2").Range.Text = Range("A16").Value
.Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
End With
 Set wrdApp = CreateObject("Word.Application")
 wrdApp.Visible = True
 strTemplateName = "C:\Documents and Settings\bethan\My Documents\Pallet Markers\1.dot"
 Set wrdDoc = wrdApp.Documents.Add(strTemplateName)
 Application.ScreenUpdating = False
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D17").Value
 .Bookmarks("SpecNo").Range.Text = Range("B17").Value
 .Bookmarks("Qty").Range.Text = Range("C17").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A17").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
  .Bookmarks("CustName2").Range.Text = Range("C8").Value
 .Bookmarks("Ref2").Range.Text = Range("D17").Value
 .Bookmarks("SpecNo2").Range.Text = Range("B17").Value
 .Bookmarks("Qty2").Range.Text = Range("C17").Value
 .Bookmarks("RCLon2").Range.Text = Range("J8").Value
 .Bookmarks("Custon2").Range.Text = Range("A17").Value
 .Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
 End With
 Set wrdApp = CreateObject("Word.Application")
 wrdApp.Visible = True
 strTemplateName = "C:\Documents and Settings\bethan\My Documents\Pallet Markers\1.dot"
 Set wrdDoc = wrdApp.Documents.Add(strTemplateName)
 Application.ScreenUpdating = False
With wrdDoc
 .Bookmarks("CustName").Range.Text = Range("C8").Value
 .Bookmarks("Ref").Range.Text = Range("D18").Value
 .Bookmarks("SpecNo").Range.Text = Range("B18").Value
 .Bookmarks("Qty").Range.Text = Range("C18").Value
 .Bookmarks("RCLon").Range.Text = Range("J8").Value
 .Bookmarks("Custon").Range.Text = Range("A18").Value
 .Bookmarks("DeliveryAdd").Range.Text = Range("C13").Value
  .Bookmarks("CustName2").Range.Text = Range("C8").Value
 .Bookmarks("Ref2").Range.Text = Range("D18").Value
 .Bookmarks("SpecNo2").Range.Text = Range("B18").Value
 .Bookmarks("Qty2").Range.Text = Range("C18").Value
 .Bookmarks("RCLon2").Range.Text = Range("J8").Value
 .Bookmarks("Custon2").Range.Text = Range("A18").Value
 .Bookmarks("DeliveryAdd2").Range.Text = Range("C13").Value
End With
End If 
End Sub

I can't post my whole code as it wildly exceeds the character limit of the forum, so I have given the top snippet. I can post wb & wrd doc if that would help?
Thanks