+ Reply to Thread
Results 1 to 2 of 2

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

Hybrid View

  1. 02-17-2014, 06:58 AM #1
    beenbee
    beenbee is offline
    Forum Contributor
    Join Date
    10-07-2013
    Location
    Wilts, England
    MS-Off Ver
    Excel 2013
    Posts
    100

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

    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
    Reply With QuoteRegister To Reply
  2. 02-17-2014, 08:00 AM #2
    beenbee
    beenbee is offline
    Forum Contributor
    Join Date
    10-07-2013
    Location
    Wilts, England
    MS-Off Ver
    Excel 2013
    Posts
    100

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

    I feel since I posted this I have a better handel on what I wanted to achieve so have posted again, here is the link to that post;
    http://www.excelforum.com/excel-prog...set-range.html
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Find last row with data and pass the found row number to bookmark code
    By beenbee in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 02-14-2014, 08:11 AM
  2. Loop through Column to find decimal then pass found row to bookmark code
    By beenbee in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 02-11-2014, 11:13 AM
  3. Need Loop code to Copy data or pass values
    By CodeNublet in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 02-17-2012, 08:31 AM
  4. how to deal with decimals and integers
    By wonderdunder in forum Excel General
    Replies: 2
    Last Post: 03-13-2011, 12:26 PM
  5. Round integers NOT decimals
    By b_motl in forum Excel Formulas & Functions
    Replies: 2
    Last Post: 03-19-2009, 03:31 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1