Solved: How to use LookUp/If-Then in VBA?

Hi, Actually this is a continuation of my Copy Paste Design(my latest is "How to start pasting on the last row"). And I have this code from rbrhodes. It works fine, no errors and everything, but I want to enhance it, so I don't have to modify the code everytime I have to change the filename.

The code below copies data from one file to another. And filename in the code is constant and doesn't change.

How about if FILENAME("filename.xls") of Source File(wbSrc) depends on the filename that is written in column A3 of destination file(wbDest)?

example:
if column A3 of wbDest is 12-May-10
then wbSrc filename is 12-May-10.xls
Now if I change 12-May-10 to 13-May-10 then my filename now is 13-May-10.xls

Will you use If and Then? Or will you use lookupdate since filename is a date?

And how do you use those commands?

Code:

---

Option Explicit
Sub CopyTo()

    'Declare all variables - always a good idea!
  Dim lastrow As Long
  Dim wbSrc As Worksheet
  Dim wbDest As Worksheet
    'Set to FALSE for speed/flicker
  Application.ScreenUpdating = False

    'Type in once!
  Set wbDest = Workbooks("MasterFile.xls").Sheets("Sheet2")
  Set wbSrc = Workbooks("MS Clearing File 040610.xls").Sheets("pbu006all")

    'Get last row of data
  lastrow = wbDest.Cells(Rows.Count, "A").End(xlUp).Row

    'if lastrow > 1 then add 1 to equal first BLANK row
  If lastrow > 1 Then
      lastrow = lastrow + 1
  End If

    'Use created objects not looooooooooooong.......names
    ' also avoids typing names repeatedly: too many chances for 'tpyos'!
  With wbSrc
      .Range("D2:D9000").Copy
      wbDest.Cells(lastrow, "A").PasteSpecial Paste:=xlPasteValues
      .Range("E2:E9000").Copy
      wbDest.Cells(lastrow, "B").PasteSpecial Paste:=xlPasteValues
      .Range("F2:F9000").Copy
      wbDest.Cells(lastrow, "C").PasteSpecial Paste:=xlPasteValues
  End With

    'Cleanup
  Set wbSrc = Nothing
  Set wbDest = Nothing

    'Reset
  Application.ScreenUpdating = True

End Sub

---

Thanks!

Hi genracela,

It appears that the other workbook (currently: "MS Clearing File 040610.xls") is already open when this procedure runs.

Just a thought, but rather than chance user error in typing in a name to a cell, how about a small userform with a listbox, listing currently open wb's, from which the user could choose?

That's a good idea.... but.... I don't know how create the code for the useroform:dunno ...

I created a sample worksheet for my problem.

Output.xls is wbDest the code for my combobox is

Code:

---

Private Sub Userform_Initialize()
    Dim i As Integer
    For i = 1 To 12
        ComboBox1.AddItem MonthName(i)
    Next i
End Sub

---

Questions:
1. But this only shows months, what if I want to make it day-month-year format?

2. Below is my copy paste code, How will I modify this so that the filename of the source(wbSrc) will depend on the date that I will choose in the combo box.

Code:

---

Option Explicit
Sub CopyTo()
    'Declare all variables - always a good idea!
    Dim lastrow As Long
    Dim wbSrc As Worksheet
    Dim wbDest As Worksheet
    'Set to FALSE for speed/flicker
    Application.ScreenUpdating = False
   
    'Type in once!
    Set wbDest = Workbooks("Output.xls").Sheets("Sheet1")
    Set wbSrc = Workbooks("12-May-10.xls").Sheets("Data")
   
    'Get last row of data
    lastrow = wbDest.Cells(Rows.Count, "A").End(xlUp).Row
   
    'if lastrow > 1 then add 1 to equal first BLANK row
    If lastrow > 1 Then
        lastrow = lastrow + 1
    End If
   
    'Use created objects not looooooooooooong.......names
    ' also avoids typing names repeatedly: too many chances for 'tpyos'!
    With wbSrc
        .Range("A2:A9000").Copy
        wbDest.Cells(lastrow, "A").PasteSpecial Paste:=xlPasteValues
        .Range("B2:B9000").Copy
        wbDest.Cells(lastrow, "B").PasteSpecial Paste:=xlPasteValues
        .Range("C2:C9000").Copy
        wbDest.Cells(lastrow, "C").PasteSpecial Paste:=xlPasteValues
    End With
   
    'Cleanup
    Set wbSrc = Nothing
    Set wbDest = Nothing
   
    'Reset
    Application.ScreenUpdating = True
   
End Sub

---

Thanks in advance!!!

I attached a file for you to look.

Thanks!

AHHHHHH!

New string with no link to old one (ok a reference..) In forum equivalent of a Xpost and we know how I feel about those!

I just answered this there....

Damn.

Sorry, I already marked it solved:(

I was thinking to do another thread because it's a new concern... and someone might get mad if I asked a new concern in that thread...

soweeee: pray2:

Hi genracela,

I'm sure it was an innocent oversight, but after posting the follow-up question in the other thread, if you think that it actually needs a new thread, you could post a link in the original to the new one. That way, Dusty (rbrhodes) or others don't answer in the old thread while others are responding to the new one. Does that makes sense?

Anyways, here's what I was coming up with as an example. I did not tie it in to your wb, but just a sample userform in case of help in studying how you could use in the code as an alternative to listing the filename on the sheet. Hope it is of help.

Code:

---

Option Explicit
 
'// Not super well thought through, but maybe enough basics to read through help and get//
'// you going on assigning the source wb via the selection in listbox.                  //
 
Private Sub cmdCancel_Click()
    MsgBox "Handle non-selection here, or maybe in 'UserForm_QueryClose'", vbInformation, vbNullString
    Unload Me
End Sub
 
Private Sub cmdOK_Click()
    MsgBox "I chose: " & Me.lstOpenWorkbooks.Value & vbCrLf & _
          "(Assign the value of ""lstOpenWorkbooks"" to a variable here.)", _
          vbInformation, vbNullString
    Unload Me
End Sub
 
Private Sub lstOpenWorkbooks_Click()
    Me.cmdOK.Enabled = True
End Sub
 
Private Sub lstOpenWorkbooks_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MsgBox "I chose: " & Me.lstOpenWorkbooks.Value & vbCrLf & _
          "(Assign the value of ""lstOpenWorkbooks"" to a variable here.)", _
          vbInformation, vbNullString
    Unload Me
End Sub
 
Private Sub UserForm_Initialize()
Dim _
wb              As Workbook, _
i              As Long, _
bolAdded        As Boolean
 
    '// 'Me' in a userform refers to the userform; if used in a worksheet's module,    //
    '// refers to the sheet.                                                            //
    With Me
        '// These properties can be set in design time; written out so you can see/study//
        '// the porperties.                                                            //
        .Height = 142.5
        .Width = 202.5
 
        .Caption = "Select Workbook"
        With cmdOK
            .Height = 24
            .Left = 120
            .Top = 62.25
            .Width = 72
 
            .Caption = "OK"
            .Enabled = False
            With .Font
                .Bold = True
                .Size = 11
            End With
        End With
        With .cmdCancel
            .Height = 24
            .Left = 120
            .Top = 92.25
            .Width = 72
 
            .Caption = "Cancel"
            With .Font
                .Bold = True
                .Size = 11
            End With
        End With
 
        With .lstOpenWorkbooks
            .Height = 110.25
            .Left = 6
            .Top = 6
            .Width = 108
 
            .MultiSelect = fmMultiSelectSingle
 
            '// Default value of a Boolean is False, just explicit for clarity          //
            bolAdded = False
            '// Loop thru wb's...                                                      //
            For Each wb In Workbooks
                '// ...skipping thisworkbook...                                        //
                If Not wb.Name = ThisWorkbook.Name Then
                    '// ...adding wb names to the listbox.  I chose to alpha-sort      //
                    '// then names on the way in.                                      //
                    For i = 0 To .ListCount - 1
                        If wb.Name < .List(i) Then
                            .AddItem wb.Name, i
                            bolAdded = True
                            Exit For
                        End If
                    Next
                    If Not bolAdded Then
                        .AddItem wb.Name
                    Else
                        bolAdded = False
                    End If
                End If
            Next
            .ListIndex = -1
        End With
    End With
End Sub

---

Okay, I'll do that next time.

And thanks for all the help.

:( I hope dusty will forgive me huhuhu:boohoo

No problems, mate!

Thank you Dusty!

And thank you GTO! But I guess it'll be easier for me to not to use the userform for now... I tried using it yesterday but I just can't get it right. I'm trying to run Dusty's instead(call me lazy but I really am twisting my brains already, and I just can't stop).

Dusty's code with my modification( I did a sample worksheet so not to ruin my original worksheet):

Code:

---

Sub CopyTo()
   
    'Declare all variables - always a good idea!
    Dim lastrow As Long
    Dim wbSrc As Worksheet
    Dim wbDest As Worksheet
   
    '//NEW
    Dim FileNameSrc As String
    Dim FileSheetSrc As String 'JIC
    '//End
   
    'Set to FALSE for speed/flicker
    Application.ScreenUpdating = False
   
   
    'Type in once!
    Set wbDest = Workbooks("Output.xls").Sheets("Sheet1")
   
    '//NEW
    FileNameSrc = wbDest.Range("A3")
   
    'Check for file ext. Code needs full name!
    If Right(FileNameSrc, 4) <> ".xls" Then
        FileNameSrc = FileNameSrc & ".xls"
    End If
   
         
    '//Build it all here
    Set wbSrc = Workbooks(FileNameSrc).Sheets("Sheet1")
   
    '//End
   
    '//This will find at minimum row 4 as 'FileNameSrc' is now in A3. So 'If lastrow = 1' (below) is no longer needed...
   
    'Get last row of data
    lastrow = wbDest.Cells(Rows.Count, "A").End(xlUp).Row
   
    'if lastrow > 1 then add 1 to equal first BLANK row
    If lastrow > 1 Then
        lastrow = lastrow + 1
    End If
   
    'Use created objects not looooooooooooong.......names
    ' also avoids typing names repeatedly: too many chances for 'tpyos'!
    With wbSrc
        .Range("A2:A9000").Copy
        wbDest.Cells(lastrow, "A").PasteSpecial Paste:=xlPasteValues
        .Range("B2:B9000").Copy
        wbDest.Cells(lastrow, "B").PasteSpecial Paste:=xlPasteValues
        .Range("C2:C9000").Copy
        wbDest.Cells(lastrow, "C").PasteSpecial Paste:=xlPasteValues
    End With
End Sub

---

But it would not run and the line below is highlighted in yellow

Code:

---

Set wbSrc = Workbooks(FileNameSrc).Sheets("Sheet1")

---

Thanks again!

I forgot again...

If this might help

Thanks a million!

Hi,

Your example has the filename in B3 the code is looking in A3...

If you want the code to open the file as well it needs a path...

[VBA]

'//NEW
FileNameSrc = wbDest.Range("A3")

[/VBA]

I already modified it to this

Code:

---

Sub CopyTo()
   
    'Declare all variables - always a good idea!
    Dim lastrow As Long
    Dim wbSrc As Worksheet
    Dim wbDest As Worksheet
   
    '//NEW
    Dim FileNameSrc As String
    Dim FileSheetSrc As String 'JIC
    '//End
   
    'Set to FALSE for speed/flicker
    Application.ScreenUpdating = False
   
   
    'Type in once!
    Set wbDest = Workbooks("Output.xls").Sheets("Sheet1")
   
    '//NEW
    FileNameSrc = wbDest.Range("B3")
   
    'Check for file ext. Code needs full name!
    If Right(FileNameSrc, 4) <> ".xls" Then
        FileNameSrc = FileNameSrc & ".xls"
    End If
   
    'This is JIC you wanted to specify sheet as well...
   
    FileSheetSrc = "Sheet1" 'or range... eg: FileSheetSrc = wbdest.range("A4") or whatever...
   
    '//Build it all here
    Set wbSrc = Workbooks(FileNameSrc).Sheets(FileSheetSrc)
   
    '//End
   
    '//This will find at minimum row 4 as 'FileNameSrc' is now in A3. So 'If lastrow = 1' (below) is no longer needed...
   
    'Get last row of data
    lastrow = wbDest.Cells(Rows.Count, "A").End(xlUp).Row
   
    'if lastrow > 1 then add 1 to equal first BLANK row
    If lastrow > 1 Then
        lastrow = lastrow + 1
    End If
   
    'Use created objects not looooooooooooong.......names
    ' also avoids typing names repeatedly: too many chances for 'tpyos'!
    With wbSrc
        .Range("A2:A9000").Copy
        wbDest.Cells(lastrow, "A").PasteSpecial Paste:=xlPasteValues
        .Range("A2:A9000").Copy
        wbDest.Cells(lastrow, "B").PasteSpecial Paste:=xlPasteValues
        .Range("B2:B9000").Copy
        wbDest.Cells(lastrow, "C").PasteSpecial Paste:=xlPasteValues
    End With
End Sub

---

But it still highlight the same line:(

Need to format as string:


[VBA]

'//NEW
FileNameSrc = Format(wbDest.Range("B3"), "d-mmm-yy")

[/VBA]

It still highlighting in yellow...

and if you debug it( the yellow line of code) what does it say?

Greetings genracela,

I am thinking that you may have missed a point that both Dusty and I at least inferred or alluded to. Is 12-May-10.xls already open when the procedure is run?

Mark

Yes, both files are open.

Sorry if this concern is taking too long to resolve:(

Strange it works fine for me... Is your system date American per chance?

Anyways stick this in and post what it says:
[VBA]

'//FIND THIS LINE IN THE CODE
'This is JIC you wanted to specify sheet as well...
FileSheetSrc = "Sheet1" 'or range... eg: FileSheetSrc = wbdest.range("A4") or whatever...

'//ADD THIS BIT

Dim waddaf As String

waddaf = FileNameSrc & " & " & FileSheetSrc

'//POST WHAT THIS SAYS

MsgBox (wadddaf)

'//END

'//Build it all here
Set wbSrc = Workbooks(FileNameSrc).Sheets(FileSheetSrc)

[/VBA]

thanks