PDA

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



genracela
05-11-2010, 09:02 PM
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?




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!

GTO
05-11-2010, 09:25 PM
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?

genracela
05-11-2010, 09:28 PM
That's a good idea.... but.... I don't know how create the code for the useroform:dunno ...

genracela
05-11-2010, 10:28 PM
I created a sample worksheet for my problem.

Output.xls is wbDest the code for my combobox is


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.



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!!!

genracela
05-11-2010, 10:30 PM
I attached a file for you to look.

Thanks!

rbrhodes
05-12-2010, 12:07 AM
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.

genracela
05-12-2010, 01:02 AM
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:

GTO
05-12-2010, 01:40 AM
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.


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

genracela
05-12-2010, 02:59 AM
Okay, I'll do that next time.

And thanks for all the help.

:( I hope dusty will forgive me huhuhu:boohoo

rbrhodes
05-12-2010, 02:51 PM
No problems, mate!

genracela
05-12-2010, 05:05 PM
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):

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


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

Thanks again!

genracela
05-12-2010, 05:10 PM
I forgot again...

If this might help

Thanks a million!

rbrhodes
05-12-2010, 06:35 PM
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...



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

genracela
05-12-2010, 06:44 PM
I already modified it to this



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:(

rbrhodes
05-12-2010, 09:17 PM
Need to format as string:




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

genracela
05-12-2010, 09:27 PM
It still highlighting in yellow...

Aussiebear
05-12-2010, 10:58 PM
and if you debug it( the yellow line of code) what does it say?

GTO
05-13-2010, 01:29 PM
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

genracela
05-13-2010, 04:44 PM
Yes, both files are open.

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

rbrhodes
05-13-2010, 05:45 PM
Strange it works fine for me... Is your system date American per chance?

Anyways stick this in and post what it says:


'//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)

genracela
05-13-2010, 05:56 PM
thanks