VBA: IF conditions not being recognized - excel

Want to do:
A.If only one row is present in the data sheet, copy and paste that lone row and paste it to the named sheet
B.if there are multiple rows of data, copy all then paste
Issues Having with Current Code:
it disregards the first if condition and goes straight to the next one which copies the range and everything below even if theres only one row of data present.
here's my code with the following condtions:
ws2 = source data sheet
wsA = sheet data will be pasted on
copied data if conditions are met should be pasted on the last available blank row in column A of WsA
k = ws2.Range("a6", ws2.Range("a6").End(xlDown)).Rows.Count
If k <= 1 Then
ws2.Activate
rngB.Select
Selection.Copy
wb2.Activate
wsA.Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
ws2.Activate
rngB.Select
Range(rngB, ActiveCell.End(xlDown)).Select
Selection.Copy
wb2.Activate
wsA.Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
data sheet

If there is no data below row 6 then ws2.Range("a6").End(xlDown) will extend down to the bottom of the sheet (so k > ~1000000)
To detect if only one row of data exists, try
If IsEmpty(ws2.Range("a6").Offset(1,0) then
' Only one row
Else
' More than one row
End If
And, head the advise to avoid select.

Related

Paste to row based on row number value in cell

I am trying to write a macro that copies data from a form (Contractor Entry Form, range "U5:AT5") and pastes it to a database (CONTRACTOR DATABASE).
When a record is edited, it requests the Employee ID# and finds that row on the database, and pastes that row number reference temporarily into cell Contractor Entry Form "L1".
I need to then paste the copied data to the database on that row number (-1) that is referenced in cell "L1". If there is no value in "L1" that means it is a new entry and should then just paste to the last row -- as opposed to pasting over a previous record row.
Help, please. My code is here--
Sub ContractorEntry
Range("U5:AT5").Copy
Sheets("CONTRACTOR_DATABASE").Select
Dim R As Integer
R = Worksheets("CONTRACTOR ENTRY").Range("L1").value
'note-- if there is a value in CONTRACTOR ENTRY L1>0 then
' (it represents a row number --- paste value to that row -1 onto
' Contractor Database sheet.
If Worksheets("CONTRACTOR ENTRY").Range("L1") > 0 Then
Sheets("CONTRACTOR_DATABASE").Cells (R -1, 1)
Selection.PasteSpecial
End If
Else
'if there is no value in cell L1 then the following to just paste to the next blank row
lMaxRows = Cells(Rows.Count, "A").End(xlUpSelection.PasteSpecial.Row
Range("A" & lMaxRows + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks :=False, Transpose:=False
'This returns to the contractor entry form and clears contents
Sheets("CONTRACTOR ENTRY").Select
Range("D3:M1").Select
Selection.ClearContents
'Should go back to Contractor Entry Form for Name and a new entry in cell D3
Range("D3").Select
End Sub
There's almost never any need to use Select/Activate see here for guidelines on how to improve your code: How to avoid using Select in Excel VBA
Something like this should work:
Sub ContractorEntry()
Dim rw, wsInput As Worksheet, wsDB As Worksheet
'use worksheet varaibles for easier maintenance
Set wsInput = ThisWorkbook.Worksheets("CONTRACTOR ENTRY")
Set wsDB = ThisWorkbook.Worksheets("CONTRACTOR_DATABASE")
rw = wsInput.Range("L1").Value - 1
'if row not present then get next empty row
If rw < 1 Then rw = wsDB.Cells(Rows.Count, "A").End(xlUp).Row + 1
'copy over values directly (no copy/paste)
With wsInput.Range("U5:AT5")
wsDB.Cells(rw, "A").Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
With wsInput
.Activate
.Range("D3:M1").ClearContents
.Range("D3").Select
End With
End Sub

How to paste to the last filled row without including first row (headers)?

I'm trying to paste data at the end of the last filled row in a sheet, but my syntax overwrites my headers in Row 1 during the first iteration of the loop.
I'm running a looped code that copies and transposes variables from multiple spreadsheets on a single sheet. Variables are in two columns in the source files but go onto one row in the destination file. I use a "next row" function to place the data from the first column into the first empty row. I then want to use a "last row" function to append the data from the second column to the same row. However, during the first operation, my code doesn't know the difference between the first line of data and the variable names on the first row, so the second column data ends up shifted one row up from the first half of the data.
Dim lastrow As Long
Dim nextrow As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
nextrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row + 1
'assigns objects for the last filled row and the next unfilled row
wb1.Worksheets("Database").Range("B1:B578").Copy
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(nextrow, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
DoEvents
Application.CutCopyMode = False
'copies the relevant data from Column B in Sheet 3 of the source file...
'then transposes and pastes into the next available row of the destination file
wb1.Worksheets("Database").Range("C32:C578").Copy
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(lastrow, 579).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
DoEvents
Application.CutCopyMode = False
'copies the relevant data from Column C in Sheet 3 of the source file...
'then tranposes and pastes into the same row as the previous function, beginning with...
'the next cell after the last data point
Is there a good way to adjust the syntax so that data does not paste to the first row of the spreadsheet? The goal is to have both columns from a source spreadsheet be pasted to the same row, and that each spreadsheet in the loop be pasted to the next empty row available. I appreciate any suggestions.
I think you want to change the cell you are pasting to, you don't want to paste in lastrow it should be nextrow.
You have;
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(lastrow, 579).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Change to;
Workbooks("zzmaster.xlsx").Worksheets("Sheet1").Cells(nextrow, 579).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Looks like it wouldn't only be the first iteration of your loop but all of them. Try adding a breakpoint where you set lastrow and step through the execution to see where the issues arises, it will help to step through a few iterations of your loop and assess if it only happens once or not.
Assuming your header is at row 1, can you add coding after this:
lastrow = sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
If lastrow=1 then lastrow=2

Copy cells to a new row in another sheet

I need to copy a few cells from a form on sheet Form, then paste them into a new row on sheet Activities.
Breaking it down:
When the button is clicked:
The cells "B2,B3,B4,B5,B6,A10,A16,A21,A24,E10,E17,E20,E23,E26,I10,I12,I14,I16,M10,M12,M14,M16,M19,M22" will be selected on the active sheet (Form) and copied.
The copied cells are pasted on another sheet (Activities) and pasted on a new row (something like A + 1)
This is what I have so far:
Private Sub CommandButton1_Click()
Sheets("Form").Select
Range("B2,B3,B4,B5,B6,A10,A16,A21,A24,E10,E17,E20,E23,E26,I10,I12,I14,I16,M10,M12,M14,M16,M19,M22").Select
Selection.Copy
Sheets("Activities").Select
If Sheets("Activities").Range("A9") = "" Then
Sheets("Activities").Range("A9").PasteSpecial Paste:=xlPasteValues
Else
Sheets("Activities").Range("A10").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
End Sub
But it's not working properly, and I haven't managed to figure out the A+1 yet.
First of all, You should avoid Select statement if it's not necessary (it raises events unnecessarily, etc.).
My approach would be:
Dim rng As Range
Set rng = Sheets("Novo Pedido").Range("B2,B3,B4,B5,B6,A10,A16,A21,A24,E10,E17,E20,E23,E26,I10,I12,I14,I16,M10,M12,M14,M16,M19,M22")
For Each cell In rng
'here you copy to another sheet, one row lower
Sheets("Geral").Cells(cell.Row + 1, cell.Column).Value = cell.Value
Next cell

How can I consolidate data between 2 different Workbooks?

I need to consolidate 2 students’ registrations between different workbooks (holding and subsidiary). So when I click the button “Generate Graphic”, the data are consolidated in the sheet “Total” and then, the number of courses (Excel, Word, Access…) are counted and the graphic is generated in the sheet “Graphic”. The first test is ok, but when I click again, the list is increasing with the same data of the subsidiary’s workbook. There’s something in the code I need to change but I don’t know what.
Could you help me?
My code is:
Sub GerarGrafico()
Dim k As Long
'copying data of the “Course Booking” Sheet
Sheets("Course Booking").Select
Range("A1").Select
linini = 2
'Select the last row
Selection.End(xlDown).Select
linfin = Selection.Row
'Select the last column
Selection.End(xlToRight).Select
colfin = Selection.Column
Range(Cells(linini, 1), Cells(linfin, colfin)).Select
Selection.Copy
‘copying data in the sheet "Total"
Sheets("Total").Select
Cells(linini, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
‘Copying data of the “reserva filial.xlsm”
caminho = ThisWorkbook.Path
Workbooks.Open caminho & "\" & "reserva filial.xlsm"
'copying data
Range("A1").Select
linini2 = 2
'Select the last row
Selection.End(xlDown).Select
linfin2 = Selection.Row
'Select the last column
Selection.End(xlToRight).Select
colfin2 = Selection.Column
Range(Cells(linini2, 1), Cells(linfin2, colfin2)).Select
Selection.Copy
Windows("Trabalho_Felipe Granado_v8.xlsm").Activate
Sheets("Total").Select
'Select the last row with value
Selection.End(xlDown).Select
k = ActiveCell.Row + 1
Cells(k, 1).Activate
Application.Windows("reserva filial.xlsm").Visible = False
'pasting data "reserva filial.xlsm" in the sheet "Total"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns.HorizontalAlignment = xlCenter
This part of the code navigates to the end of the data in the sheet
'Select the last row with value
Selection.End(xlDown).Select
k = ActiveCell.Row + 1
Cells(k, 1).Activate
Then you paste in "reserva filial.xlsm" data.
It works fine on the first pass, but the second time you run the code, you (correctly) paste in the first workbook data, LEAVING THE SECOND WORKBOOK DATA BENEATH IT, navigate to the end of the data, and repaste in the second workbook data.
Depending on how your Excel project fits together you might wish to clear the entire contents of Sheets("Total") or a subset of it using the .ClearContents method.
It works as the Ctrl + Shift + Down (arrow) and Ctrl + Shift + Right (arrow) in Excel. For now it's ok and it will be used only as a list. I really appreciatte your advise. I am a new VBA and Stack Overflow user, and this community is very useful because all of your contribution.

Copy data from one column, paste in first empty column

I have data in COLUMN H2. . I want to copy them somewhere else on the same spreadsheet.
But where I copy it will change one COLUMN at a time, as each column below gets filled, by the macro.
My existing macro successfully searches for, and pastes this column of data into an empty column below, such as B31. When I have 10 new pieces of data, the next time I run the macro, I want it to paste it into C31, in Column C (being the next empty row) The next time, D31.......etc.. My macro repeatedly grabs the data in H2:H11 and pastes it into B31, but overwrites that column each time I run the macro again. It is not "seeing" column B already having data placed there by running the macro before.... What is wrong with the code?
Range("H2:H11").Select Selection.Copy
Range("A31").Select
Range("A31:M31").End(xlToLeft).Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Rows("1:10").EntireRow.Select
Application.CutCopyMode = False
Range("A31:M31").End(xlToLeft).Offset(0, 1).Select
should be
Range("M31").End(xlToLeft).Offset(0, 1).Select
Alternative solution is below (i've not tested it, as i'm not on my MS PC, sorry)
dim lRow as Long 'Output Row
lRow = 31 'Start at row 31
For i = 2 to 13 'Column B to Column M
'Count if there is any values in the columns
'(if there is a header then change the 0 to 1)
If Application.WorksheetFunction.CountA(ActiveSheet.Columns(i)) = 0 Then
For Each c in Range("H2:H11") 'Cycle through output values
ActiveSheet.Cells(lRow, i).value = c.Value 'Assign values
lRow = lRow + 1 'Increment row number
next c
exit for 'exit column loop
end if
next i

Resources