Good day, below is a sample of code i am trying to get to work. Normally this lastrow call i run works perfectly in the worksheet but when i try to use on a foreign workbook like below, it doesnt. What am i doing wrong?
thanks
Dim rngTestArea As Range
Dim i As Long
Dim j As Double
Dim MyResult As String
Dim geodis, Location As Variant
Ret1 = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", _
, "Please select file")
If Ret1 = False Then Exit Sub
Set wb2 = Workbooks.Open(Ret1)
lastRow = wb2.Sheets(2).Range("C" & Rows.Count).End(xlUp).Row
I guess "it doesn't (work)" stands for "it doesn't pick the right last row index"
you have to use:
With wb2.Sheets(2)
lastRow = .Range("C" & .Rows.Count).End(xlUp).Row
End With
so that Rows.Count also refers to the wanted worksheet (Sheets(2))
Related
I am a trainee in a company and basically became tech support (better than coffee maker though)
And so i'm trying to get one closed workbook to copy data into an open one
So far this is the code i've got but i've some troubles with the if statement
Sub allergo()
Dim lastRow As Long
Dim bkBk1 As Workbook, wkBk2 As Workbook
Dim wkSht As Object
Dim mnt As String
lr = wkBk2.Sheets(1).Range("R" & Rows.Count).End(xlUp).Row
mnt = InputBox("Enter Filename")
Set wkBk1 = ActiveWorkbook
Set wkBk2 = Workbooks.Open("Documents\" & mnt & ".xlsx")
For Each cell In wkBk1.Sheets(1).Range(wkBk1.Sheets(1).Cells(2, "R"), wkBk1.Sheets(1).Cells(lr, "R"))
wkBk1.Sheets(1).Range("R1:R" & lr).Value = wkBk2.Sheets(1).Range("R1:R" & lastRow).Value
wkBk2.Close
End Sub
Basically I've got two files that have the same columns but between some weeks rows disapear or appear as each row is a purchase order with a specific number and in row R we add comments and i want the comments in column R to copy to the new work book on the row where there's the same purchase order number. While some comments are attached to purchase orders that are not in the file anymore so they are not needed and some purchase orders have moved so i can't just copy paste.
Not sure the If is a good idea as it won't compare my row E 146 with all the others of the new work book and thus only test E146 closed workbook = E146 newworkbook while it should test E146 closed = E147/E148 etc..
This is the closed workbook:
This is the new workbook:
Thanks for the help !
Maybe a VLOOKUP is possible for this kind of things i'm not sure ..
Sub strilltrying()
Dim ws As Worksheet
Set ws = Sheets("Sheet 1")
Dim lr As Long
lr = ws.Cells(Rows.Count, "B").End(xlUp).Row
Cells(lr, "R").Formula = "=VLOOKUP(E2,'H:\Documents\[OPEN ORDERS 16.07.2018.xlsx]Sheet 1'!$E:$R,14)"
End Sub
This is the vlookup formula that works but not fully as i've to take two different variables.. I found that index + match can do it but i'm having a hard time figuring it out.
I'd need an index formula that compares column E and column J in the way of the vlookup.
Sub allergo()
Dim lastRow As Long
Dim bkBk1 As Workbook, wkBk2 As Workbook
Dim wkSht As Object
Dim mnt As String
lr = wkBk2.Sheets(1).Range("R" & Rows.Count).End(xlUp).Row
mnt = InputBox("Enter Filename")
Set wkBk1 = ActiveWorkbook
Set wkBk2 = Workbooks.Open("Documents\" & mnt & ".xlsx")
For Each cell In wkBk1.Sheets(1).Range(wkBk1.Sheets(1).Cells(2, "R"), wkBk1.Sheets(1).Cells(lr, "R"))
if cell = "" then 'add your clause here
wkBk1.Sheets(1).Range("R1:R" & lr).Value = wkBk2.Sheets(1).Range("R1:R" & lastRow).Value
end if
next cell
wkBk2.Close
End Sub
Your requirements are not entirely clear, I would avoid a loop if possible as well.
I am very new to Visual basic, I have an excel sheet in the following format as shown in the image below.
I need to write a VB code to create a spreadsheet in the format as shown in the image below. The model name should be printed for every country that has row and column value '1' in the excel sheet. In other words just need to print Model name and Country name that has value '1' in the spreadsheet. If the cell is empty or value '0' then we need not print the model name for that particular country.
How do I go about it? I have been watching videos to do this but to no avail.
Can anyone please tell me how to do this? Any kind of help would be greatly appreciated. thanks in advance.
Edited: The current output after using the below code is in this screenshot
This should work smoothly, it will created a new sheet at every run to display the output! ;)
Sub test_Dazzler()
Dim wB As Workbook, _
wBNeW As Workbook, _
wSSrC As Worksheet, _
wSDesT As Worksheet, _
LastRow As Long, _
LastCol As Integer, _
WrintingRow As Long, _
ModeL As String
Set wB = ThisWorkbook
Set wSSrC = wB.ActiveSheet
LastRow = wSSrC.Range("A" & wSSrC.Rows.Count).End(xlUp).Row
LastCol = wSSrC.Range("A1").End(xlToRight).Column
Set wSDesT = wB.Sheets.Add
wSDesT.Cells(1, 1) = "Model": wSDesT.Cells(1, 2) = "Countries"
With wSSrC
For i = 2 To LastRow
ModeL = .Range("A" & i).Value
For j = 2 To LastCol
If .Cells(i, j) <> 1 Then
Else
WrintingRow = wSDesT.Range("A" & wSDesT.Rows.Count).End(xlUp).Row + 1
wSDesT.Cells(WrintingRow, 1) = ModeL
wSDesT.Cells(WrintingRow, 2) = .Cells(1, j)
End If
Next j
Next i
DoEvents
WsDest.Copy
End With
Set wBNeW = ActiveWorkbook
Dim intChoice As Integer
Dim strPath As String
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogSaveAs).Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
strPath = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
If strPath <> False Then wBNeW.SaveAs strPath
'displays the result in a message box
Call MsgBox(strPath, vbInformation, "Save Path")
End If
MsgBox "I'm done!"
End Sub
I'm new to VBA, but I'm trying.(-:
I have found this code, which is working wonderfully except for two problems:
1. I have to manually change the range each time I want to use it.
2. The emails aren't sent automatically. I have to hit "Send" on each 'new mail' window, and there are over a hundred windows...
Any ideas?
Thanks,
Inbar.
ASSUMES SCHOOL NAME IS COLUMN "E" This macro will copy each row into a new sheet which will be created and named as a school name using the school_name in column E. You would then have to e-mail each sheet to the respective school (which could be automated in a separate macro.
EDIT: Fixed code and tested working:
Sub SortKids()
Dim CurRow As Long
Dim LastRow As Long
Dim NameTest As String, NameStr As String
Dim DestRow As Long
Dim NewWS As Worksheet
On Error Resume Next
LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
For CurRow = 2 To LastRow
If Sheets("Master").Range("E" & CurRow).Value = "" Then
NameStr = "Error"
Else
NameStr = Sheets("Master").Range("E" & CurRow).Value
End If
NameTest = Worksheets(NameStr).Name
If Err.Number = 0 Then
Else
Err.Clear
Set NewWS = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count))
NewWS.Name = NameStr
Sheets("Master").Rows(1).Copy
Sheets(NameStr).Rows(1).PasteSpecial
End If
DestRow = Sheets(NameStr).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Master").Rows(CurRow).Copy
Sheets(NameStr).Rows(DestRow).PasteSpecial
Next CurRow
MsgBox "Done"
End Sub
I am writing a copy to last row code that seems to copy the same exact number of rows each time.
The code is to open up a new workbook, take a specific sheet from the new workbook, copy all the available data, and pasting it into the original workbook. My code is below
Dim wkb As Workbook
Dim wkbFrom As Workbook
Dim wks As Worksheet
Dim path As String, FilePart As String
Dim TheFile
Dim loc As String
Dim Lastrow As Long
Dim lr As Long
Dim lr2 As Long
FilePart = Trim(shPivot.Range("E17").Value)
TheFile = Dir(path & "*" & FilePart & ".xls")
Set wkbFrom = Workbooks.Open(loc & path & TheFile & FilePart)
Set wks = wkbFrom.Sheets(shPivot.Range("E15").Value)
Lastrow = ActiveSheet.UsedRange.Rows.Count
lr = shCurrentWeek.Range("A" & Rows.Count).End(xlUp).Row
lr2 = wks.Range("A" & Rows.Count).End(xlUp).Row
Debug.Print lr
Debug.Print lr2
'Copies range from report generated to share drive and pastes into the current week tab of open order report
wks.Range("A2:N" & lr2).Copy wkb.Sheets("Current Week").Range("A4")
'Closes the workbook in the shared drive
wkbFrom.Close False
I am constantly getting 187 rows of data even if the "new opened Workbook" has only 167. And data fills in column "A" all the way to row 507. Help?!
I've had trouble getting the last row of data myself from some worksheets; here is code that I use now that seems to be most consistent for me.
objExcelWks.Range("A1").Offset(objExcelWks.Rows.Count - 1, 0).End(xlUp).Row
Maybe that will work?
I have formulas from columns O -> X and need them drag them to last row used. Below is the current code I am using:
Dim wkb As Workbook
Dim wkbFrom As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim path As String, FilePart As String
Dim TheFile
Dim loc As String
Dim Lastrow As Long
Set wkb = ThisWorkbook
loc = shPivot.Range("E11").Value
path = shPivot.Range("E12").Value
FilePart = Trim(shPivot.Range("E13").Value)
TheFile = Dir(path & "*" & FilePart & ".xls")
Set wkbFrom = Workbooks.Open(loc & path & TheFile & FilePart)
Set wks = wkbFrom.Sheets("SUPPLIER_01_00028257_KIK CUSTOM")
Set rng = wks.Range("A2:N500")
'Copies range from report generated to share drive and pastes into the current week tab of open order report
rng.Copy wkb.Sheets("Current Week").Range("A4")
With ActiveSheet
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("O4:X4").AutoFill .Range("O4:X4").Resize(Lastrow)
End With
The code Lastrow is not dragging the formulas down
You can do auto-fill like this in VBA (verified using macro recording)
Range("O1:X1").Select
Selection.AutoFill Destination:=Range("O1:X25"), Type:=xlFillDefault
Now that you have this code as a base to work with you can use any variables you like in the syntax like this:
Range("O1:X1").Select
Selection.AutoFill Destination:=Range("O1:X" & Lastrow), Type:=xlFillDefault
I used this:
Sub sum_1to10_fill()
Sheets("13").Activate
Range("EG12").Copy
Range("EG12:FT36").PasteSpecial xlPasteFormulas
End sub
...and filled up my whole label both down and right.