I have the following macro which works fine for me in terms of adding data and new lines:
Private Sub CommandButton1_Click()
Dim emptyRow As Long
'Make WOTracker active
Sheets("WOTracker").Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
'Transfer information
Cells(emptyRow, 1).Value = TextBox1.Value
Cells(emptyRow, 5).Value = TextBox2.Value
End Sub
What I need help with is modifying the code so that instead of adding data below existing rows (to a new line), it pushes the previously added data down. So what was in row 2 goes to row 3 and the new data is inserted into Row 2.
Just insert a new row at Range("A2") and the change your last row variable to a 2 to signify row 2
Private Sub CommandButton1_Click()
With ThisWorkbook.Sheets("WOTracker")
.Cells(2, 1).EntireRow.insert
.Cells(2, 1).Value = TextBox1.Value
.Cells(2, 5).Value = TextBox2.Value
End With
End Sub
Related
I have an excel file automated with a macro. I have a userform interface (see photo below). Inside the userform is a combobox and a textbox.
I want to add something in the worksheet but depending on what type of expenses it is and I don't understand what is wrong in my code below. What I want is if I add something in the column of "taxi" (2nd row), I can also in "carwash" (2nd row) but it appears to a different result. I am also not able to add data on 3rd, 4th, 5th rows and so on.
Private Sub CommandButton1_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
'find first empty row in database
Set rngNullString = Intersect(ws.Columns("A"), ws.Columns("A")).Find("")
If rngNullString.row < ws.Cells(ws.Rows.Count, "A").End(xlUp).row Then
Set rngNullString = Intersect(ws.Columns("A"), _
ws.Columns("A")).SpecialCells(xlCellTypeBlanks)
End If
iRow = rngNullString.row
'check for Name number
If Trim(Me.TextBox1.value) = "" Then
Me.TextBox1.SetFocus
MsgBox "Please complete the FORM"
Exit Sub
End If
'copy the data to the database
If Me.ComboBox1.value = "Taxi" Then
ws.Cells(iRow, 1).value = Me.ComboBox1.value
ws.Cells(iRow, 2).value = Me.TextBox1.value
End If
If Me.ComboBox1.value = "Carwash" Then
ws.Cells(iRow, 3).value = Me.ComboBox1.value
ws.Cells(iRow, 4).value = Me.TextBox1.value
End If
MsgBox "Sucessfully! Data added", vbOKOnly + vbInformation, "Data Notification"
'clear the data
Me.TextBox1.value = ""
Me.ComboBox1.value = ""
Me.TextBox1.SetFocus
Unload Me
End Sub
Following textboxs in userform:
ClientFirstName
ClientLastName
Referral1FirstName
Referral1LastName
Current Code:
Private Sub CommandBox_Click()
Dim emptyRow as Long
'MakeSheet1 active
Sheet1.Activate
'Determine emptyRow
emptyRow = WorksheetFunction.CountA(Range("A:A"))+1
'Transfer Information
Cells(emptyRow, 1).Value = ClientFirstName.Value
Cells(emptyRow, 2).Value = ClientLastName.Value
Cells(emptyRow, 3).Value = Referral1FirstName.Value
Cells(emptyRow, 4).Value = Referral1LastName.Value
End Sub
Ideally the textbox would input the data for empty Row 1 and then insert a new row where Columns C and D are in Row 2 (in positions Columns A and B)
Ideal Output
To improve efficiency of your code a bit you could re-write it like below, but your logic looks sound and I'd expect the right outcomes? Below codee is assuming the referralname should be in the row below:
Private Sub CommandBox_Click()
Dim emptyRow as Long
Dim TargetSheet as Worksheet
'Direct code to run on Sheet1
Set TargetSheet = ThisWorkbook.Sheet1 'Could also be ThisWorkbook.Sheets("SheetNameHere")
With TargetSheet
'Determine emptyRow
emptyRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Transfer Information
.Cells(emptyRow, 1).Value = Me.ClientFirstName.Value
.Cells(emptyRow, 2).Value = Me.ClientLastName.Value
'Assuiming you want the referral name values in the row below the client name,
'include 'Offset(1, 0) to offset the target by 1 row.
.Cells(emptyRow, 1).Offset(1, 0).Value = Me.Referral1FirstName.Value
.Cells(emptyRow, 2).Offset(1, 0).Value = Me.Referral1LastName.Value
End with
End Sub
Now we aren't relying on the ActiveSheet being the correct sheet at time of execution.
Sometimes you can get some funky results with the way you were finding the last row, where the method i've used is the same as going to the end of the worksheet and holding Ctrl + ↑.
first time asker here.
I found a nice VBA code to copy the same specific cells from multiple worksheets into a mastersheets and actually does its job (i don't remember where I founf it originally). The only small issue is that it starts to input the data from cell A2, while I would like it to start from cell A4.
Here is the code:
Sub ListFB()
Sheets("Master").Range("A4").Value = "Sheet Name"
For I = 1 To ThisWorkbook.Worksheets.Count
If Sheets(I).Name <> "RiassuntoTEST" Then
Sheets("Master").Cells(I, 1).Value = Sheets(I).Range("B2").Value
Sheets("Master").Cells(I, 2).Value = Sheets(I).Range("C2").Value
Sheets("Master").Cells(I, 3).Value = Sheets(I).Range("C10").Value
Sheets("Master").Cells(I, 4).Value = Sheets(I).Range("C11").Value
Sheets("Master").Cells(I, 5).Value = Sheets(I).Range("C15").Value
Sheets("Master").Cells(I, 6).Value = Sheets(I).Range("C16").Value
Sheets("Master").Cells(I, 7).Value = Sheets(I).Range("C20").Value
Sheets("Master").Cells(I, 8).Value = Sheets(I).Range("C21").Value
Sheets("Master").Cells(I, 9).Value = Sheets(I).Range("C25").Value
Sheets("Master").Cells(I, 10).Value = Sheets(I).Range("C26").Value
Sheets("Master").Cells(I, 11).Value = Sheets(I).Range("C29").Value
Sheets("Master").Cells(I, 12).Value = Sheets(I).Range("C30").Value
Sheets("Master").Cells(I, 13).Value = Sheets(I).Range("C33").Value
Sheets("Master").Cells(I, 14).Value = Sheets(I).Range("C34").Value
End If
Next I
End Sub
What I think it does is take value B2 from Sheet I and copy it to A2 of the mastersheet, then take C2 and copy it to B2, until it has all the required data from that sheet into the same rows, then goes to the next sheet and puts the data in the next rows. As I said above, I would like that this whole process starts from A4 instead of A2.
I am fairly new to this kind of stuff so any input and help is appreciated.
Also, does the row
Sheets("Master").Range("A4").Value = "Sheet Name"
Do anything for my purpose at all?
Thank you!
First issue:
Sheets("RiassuntoTEST").Cells(I, 1).Value
Cells holds what is known as an R1C1 reference. Meaning Row number, Column number. Since this line I = 1 To ThisWorkbook.Worksheets.Count counts from 1 to the number of worksheets you have, this will start pasting in row 1, column 1, also known as cell A1. If you want to up this to cell A4 instead, you will need to increase this by 3 like so:
Sheets("RiassuntoTEST").Cells(I + 3, 1).Value
You will need to do this on every line.
Second issue:
Also, does the row
Sheets("RiassuntoTEST").Range("A4").Value = "Nome Foglio"
Do anything for my purpose at all?
No, it does not, as stated before, your code will (now) start pasting at cell A4, so as soon as the second block starts running, this is overwritten.
I rewrote your code in such a way as to enable you to make all the amendments you might want - perhaps with a little help from the comments I inserted between the lines of code.
Option Explicit
Sub UpdateMaster()
' Variatus #STO 23 Jan 2020
Dim Wb As Workbook
Dim MasterWs As Worksheet
Dim Ws As Worksheet
Dim SourceCell() As String
Dim Rt As Long ' target row
Dim Ct As Long ' target column
Dim i As Integer
Set Wb = ThisWorkbook ' you might specify another workbook
' specify the Master worksheet here
Set MasterWs = Wb.Worksheets("TEST")
' list all the source cells here
SourceCell = Split("B2,C2,C10,C11,C15,C16,C20,C21,C25,C26,C29,C30,C33,C34", ",")
Rt = 4 ' set first row to write to here
With MasterWs
' keep contents in rows 1 to 3 (incl title)
.Range(.Cells(Rt, 1), .Cells(.Rows.Count, "A").End(xlUp) _
.Offset(0, UBound(SourceCell) + 1)) _
.ClearContents
End With
Application.ScreenUpdating = False ' speeds up execution
For i = 1 To Wb.Worksheets.Count
Set Ws = Wb.Worksheets(i)
If Not Ws Is MasterWs Then
For Ct = 0 To UBound(SourceCell)
MasterWs.Cells(Rt + i - 1, Ct + 1) = Ws.Range(Trim(SourceCell(Ct))).Value
Next Ct
End If
Next i
Application.ScreenUpdating = True
End Sub
I am trying to copy certain column from one worksheet to another but when I apply my code, I get no errors but also no results. I get blank paper. I applied this methodolgy on copying a certain row and it was copied to another worksheet perfectly.
This is regarding the successful attempt to copy row.
The code works just fine:
Sub skdks()
Dim OSheet As Variant
Dim NSheet As Variant
Dim i As Integer
Dim LRow As Integer
Dim NSLRow As Integer
OSheet = "Tabelle3" 'Old Sheet Name
NSheet = "Tabelle5" 'New Sheet Name
LRow = Sheets(OSheet).Cells(Rows.Count, 1).End(xlUp).row 'Last Row in Old Sheet
Sheets(OSheet).Activate
For i = 2 To LRow
'Finds last row in the New Sheet
If Sheets(NSheet).Cells(2, 1) = "" Then
NSLRow = 1
Else
NSLRow = Sheets(NSheet).Cells(Rows.Count, 1).End(xlUp).row
End If
'If cell has "certain # then..."
If Cells(i, 1).Value = Cells(13, 2).Value Then
Cells(i, 1).EntireRow.Copy
Sheets(NSheet).Cells(NSLRow + 1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next i
End Sub
This little piece of code is the failed attempt to copy column to another worksheet.
Sub trial()
Dim OSheet As Variant
Dim NSheet As Variant
Dim j As Integer
Dim LColumn As Integer
Dim NSLColumn As Integer
OSheet = "Tabelle2" 'Old Sheet Name
NSheet = "Tabelle5" 'New Sheet Name
LColumn = Sheets(OSheet).Cells(1, Columns.Count).End(xlToLeft).Column 'Last Column in Old Sheet
Sheets(OSheet).Activate
For j = 2 To LColumn
'Finds last column in the New Sheet
If Sheets(NSheet).Cells(1, 2) = "" Then
NSLColumn = 1
Else
NSLColumn = Sheets(NSheet).Cells(1, Columns.Count).End(xlToLeft).Column
End If
'If cell has "certain # then..."
If Cells(2, j) = Cells(13, 2) Then
Cells(2, j).EntireColumn.Copy
Sheets(NSheet).Cells(2, 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next j
End Sub
....
'If cell has "certain # then..."
If Cells(2, j) = Cells(13, 2) Then
debug.Print Cells(2, j).Address; " = "; Cells(13, 2).Address; " ---- COPY"
debug.print Cells(2, j).EntireColumn.address; Cells(2, j).EntireColumn.cells.count
debug.Print Sheets(NSheet).Cells(2, 2).Address
Cells(2, j).EntireColumn.Copy
Sheets(NSheet).Cells(2, 2).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
....
With the line If Cells(2, j) = Cells(13, 2) Then you compare the different cells from row 2 (B2, C2, D2, ...) with the value of cell "B13". If the value is the same you copy this column to the new worksheet.
Is there any equal value in your data? If yes you should get an error message with your code.
You try to copy the values of an entire column to the range starting with "B2". Of cause there is not enough space for this.
=> Either you reduce the source range or you start the destination range on row 1!
To add to the paste destination size, if you really want to paste the entire column, you either need to start at the beginning of the column or choose the entire column. Also, I think you want to make the paste column increase with your NSLColumn
If Cells(2, j) = Cells(13, 2) Then
Cells(2, j).EntireColumn.Copy
Sheets(NSheet).Columns(NSLColumn + 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
I have the below macro which inserts an array of data on each alternative row.
This works well, however, my data changes all the time so it is not the best method.
Sub inserttexteveryonerow()
Dim Last As Integer
Dim emptyRow As Integer
Last = Range("A" & Rows.Count).End(xlUp).Row
For emptyRow = Last To 2 Step -1
If Not Cells(emptyRow, 1).Value = "" Then
Rows(emptyRow).Resize(1).insert
Range(Cells(emptyRow, "A"), Cells(emptyRow, "F")).Value = Array("COLA", "COLB", "COLC", "COLD", "COLD", "COLF")
End If
Next emptyRow
End Sub
I want to have my data on Sheet1, but my alternate insert row on Sheet2 which has the specific data.
How can I edit this row:
Range(Cells(emptyRow, "A"), Cells(emptyRow, "F")).Value = Array("COLA", "COLB", "COLC", "COLD", "COLD", "COLF")
From inserting specific data to inserting the range on SHEET2 rows A1 to AF?
Assuming your request is to insert the range on Sheet2 from cell A1 to cell F1, the following should work:
Sub inserttexteveryonerow()
Dim Last As Integer
Dim emptyRow As Integer
Last = Range("A" & Rows.Count).End(xlUp).Row
For emptyRow = Last To 2 Step -1
If Not Cells(emptyRow, 1).Value = "" Then
Rows(emptyRow).Resize(1).insert
Range(Cells(emptyRow, "A"), Cells(emptyRow, "F")).Value = Worksheets("Sheet2").Range("A1:F1").Value
End If
Next emptyRow
End Sub
However, it would be a good idea to rewrite your code to use a With block, which will make it easier to correctly identify which sheets you are referring to:
Sub inserttexteveryonerow()
Dim Last As Integer
Dim emptyRow As Integer
With Worksheets("Sheet1")
Last = .Range("A" & .Rows.Count).End(xlUp).Row
For emptyRow = Last To 2 Step -1
If Not .Cells(emptyRow, 1).Value = "" Then
.Rows(emptyRow).Resize(1).insert
.Range(.Cells(emptyRow, "A"), .Cells(emptyRow, "F")).Value = Worksheets("Sheet2").Range("A1:F1").Value
End If
Next emptyRow
End With
End Sub
(Correctly qualifying which sheet you are referring to when using Range, Cells, etc, will prevent a lot of errors later.)