Excel VBA: Insert new row in multiple sheets - vba

I have a userform where the user inputs data and then clicks the button Add.
The VBA then creates a new row and inputs the data from the user into that row.
This works fine, however I want to also add a new row in a different sheet as well and this is where I am stuck.
This is my code:
Dim i As String
Dim j As String
Dim k As String
Dim m As String
Dim n As String
j = XIDBox.Value
i = OrgNameBox.Value
k = ContactNameBox.Value
m = PhoneBox.Value
n = EmailBox.Value
dstRw = Sheets("Input Data").Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Input Data").Cells(dstRw, 1).Value = i
Sheets("Input Data").Cells(dstRw, 2).Value = j
Sheets("Input Data").Cells(dstRw, 4).Value = k
Sheets("Input Data").Cells(dstRw, 6).Value = m
Sheets("Input Data").Cells(dstRw, 5).Value = n
'Here I want a code that inserts a blank row just as dstRw does above but in a different sheet.

The process is very similar to what you have in place.
'Here I want a code that inserts a blank row just as dstRw does above but in a different sheet.
Dim otherSheet As Worksheet
Set otherSheet = Sheets("Other Sheet Name")
' Insert as the last row.
Dim otherRow As Long
otherRow = otherSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
' Now write the values.
otherSheet.Cells(otherRow, 1).Value = i
otherSheet.Cells(otherRow, 2).Value = j
otherSheet.Cells(otherRow, 4).Value = k
otherSheet.Cells(otherRow, 6).Value = m
otherSheet.Cells(otherRow, 5).Value = n

This works for both sheets using an array for your sheets. You can expand it by adding items to the array in the same manner. You also don't need to store the values as variables, since the name of the object is small, you can just set the cell's values directly from the source.
This finds the last row for each sheet, adds 1 and then sets the values of the cells from your source objects. Then loops the process for the next sheet in the array.
TESTED:
Sub ValueMove()
Dim dstRw As Long
Dim sheet(1) As String
sheet(0) = "Input Data"
sheet(1) = "Different Sheet"
For s = 0 To 1
dstRw = Sheets(sheet(s)).Range("A" & Rows.count).End(xlUp).row + 1
Sheets(sheet(s)).Cells(dstRw, 1).Value = OrgNameBox.Value
Sheets(sheet(s)).Cells(dstRw, 2).Value = XIDBox.Value
Sheets(sheet(s)).Cells(dstRw, 4).Value = ContactNameBox.Value
Sheets(sheet(s)).Cells(dstRw, 6).Value = PhoneBox.Value
Sheets(sheet(s)).Cells(dstRw, 5).Value = EmailBox.Value
Next s
End Sub

Related

Excel VBA - IF/AND Issue - If values from two columns match on separate sheets, copy a value from one sheet to another in another column

I want sheets "Status" and "Ref" compared. If the values match in both columns Status!F and Ref!B AND Status!Q and Ref!C for a particular individual's data in a row, then copy the value from Ref!F to Status!H
This is my first ever attempt at writing code so it's probably full of errors, but the debugger points out the first If statement in particular. I've tried it with and without parentheses.
Sub help()
Dim i As Long
Dim j As Long
Dim index As Integer
Sheet1LastRow = Worksheets("Status").Range("F" & Rows.Count).End(xlUp).Row
Sheet2LastRow = Worksheets("Ref").Range("B" & Rows.Count).End(xlUp).Row
For index = 1 To Sheet1LastRow
If ((Worksheets("Status").Cells(i, 6).Value = Worksheets("Ref").Cells(j, 2).Value) And (Worksheets("Status").Cells(i, 17).Value = Worksheets("Ref").Cells(j, 3).Value)) Then Worksheets("Status").Cells(i, 8).Value = Worksheets("Ref").Cells(j, 6)
Next
index = index + 1
j = j + 1
i = i + 1
Do Until index = Sheet1LastRow
Loop
End Sub
edit - a note--these sheets are not in the same order. so row 1500 in Status could match something on row 3 on ref, for example
Try this
For i = 1 To Sheet1LastRow
For j = 1 To Sheet2LastRow
If ((Worksheets("Status").Cells(i, 6).Value = Worksheets("Ref").Cells(j, 2).Value) and (Worksheets("Status").Cells(i, 17).Value = Worksheets("Ref").Cells(j, 3).Value)) Then
Worksheets("Status").Cells(i, 8).Value = Worksheets("Ref").Cells(j, 6).Value
Exit for
End if
Next j
Next i

Loop macro and change ranges with each loop

I’m starting with a worksheet “Med” that has formulas/data/formatting in cells A4:P9. I need to copy those cells to cell A10 (6 rows down). I then need to fill in some of the cells from information in another worksheet “Data”. I need to repeat this the same number of times as the count of Data!(A:A) -1 dropping down 6 rows each time I copy the information.
The data that I need to fill in comes from the Sheet "Data" and moves over one column for each copy in Sheet “Med”.
I have the code to make the first copy, but don’t have any idea where to go from here. Looking at the code below the next copy would go to A16 (6 rows down from A10).
The ranges from the worksheet “Med” would also increase by 6 rows and the columns would stay the same.
The ranges from the worksheet “Data” would move over on column and the row numbers would stay the same.
Jordan
Sub Macro1()
Dim wsData As Worksheet
Dim wsMed As Worksheet
Set wsData = Sheets("Data")
Set wsMed = Sheets("Med")
'Copy data set
wsMed.Range("A4:P9").Copy wsMed.Range("A10") 'Set Premium Values
wsMed.Range("M11").Value = wsData.Range("C20").Value
wsMed.Range("M12").Value = wsData.Range("C21").Value
wsMed.Range("M13").Value = wsData.Range("C22").Value
wsMed.Range("M14").Value = wsData.Range("C23").Value 'Set Assumptions
wsMed.Range("L11").Value = wsData.Range("C24").Value
wsMed.Range("L12").Value = wsData.Range("C25").Value
wsMed.Range("L13").Value = wsData.Range("C26").Value
wsMed.Range("L14").Value = wsData.Range("C27").Value
End Sub
This macro runs the code three times
Sub Macro1()
Dim wsData As Worksheet
Dim wsMed As Worksheet
Set wsData = Sheets("Data")
Set wsMed = Sheets("Med")
Dim i As Integer, j As Integer, x As Integer
i = 10
j = 3
'Copy data set
For x = 1 To 3 ' run 3 times
wsMed.Range("A4:P9").Copy wsMed.Cells(i, 1) 'Set Premium Values
wsMed.Range("M" & i + 1).Value = wsData.Cells(20, j).Value
wsMed.Range("M" & i + 2).Value = wsData.Cells(21, j).Value
wsMed.Range("M" & i + 3).Value = wsData.Cells(22, j).Value
wsMed.Range("M" & i + 4).Value = wsData.Cells(23, j).Value 'Set Assumptions
wsMed.Range("L" & i + 1).Value = wsData.Cells(24, j).Value
wsMed.Range("L" & i + 2).Value = wsData.Cells(25, j).Value
wsMed.Range("L" & i + 3).Value = wsData.Cells(26, j).Value
wsMed.Range("L" & i + 4).Value = wsData.Cells(27, j).Value
i = i + 6
j = j + 1
Next x
End Sub

Copying excel row from one sheet to another

I am copying data from one sheet to another, from source range(Q5:AIxxx) to destination range(C6:Uxxx)
My VBA code starts with a cell and loops to the end of the column to finish copying that column's data:
Set s = Worksheets("Source")
Set d = Worksheets("Destination")
Dim i As Integer, j As Integer
j = 6
For i = 5 To 1500
If s.Cells(i, 1).Value = "a" Or s.Cells(i, 1).Value = "b" Then
d.Cells(j, 3).Value = s.Cells(i, 17).Value
j = j + 1
End If
Next i
I have > 20 columns to move, is there a way I can copy the row at once? something like this:
d.Cells(j, 3:21).Value = s.Cells(i, 17:35).Value
At the moment, I'm having to specify each column:
d.Cells(j, 3).Value = s.Cells(i, 17).Value 'column 1
d.Cells(j, 4).Value = s.Cells(i, 18).Value 'column 2
d.Cells(j, 5).Value = s.Cells(i, 19).Value 'column 3
etc
You can do it by
d.range(d.cells(j,3), d.cells(j,21)).copy
s.range(s.cells(i,17), s.cells(i,35)).pastespecial xlvalues
You can use:
.Range(<your_range>).copy
For example do:
Activesheet.Range("A1:B10").Copy
and thenjust paste anywhere you want with .Paste
ActiveSheet.Paste Destination:=Worksheets(2).Range("D1:D5")
It's a build in function in vba.
See here also for copying Range:
https://msdn.microsoft.com/en-us/library/office/ff837760.aspx
And for Paste:
https://msdn.microsoft.com/en-us/library/office/ff821951.aspx
Using ranges instead can make it a bit easier:
Dim s As Range, d As Range
Set d = Worksheets("Destination").Cells(6, 15) ' notice the column 15
For Each s in Worksheets("Source").Range("A5:A1500")
If s = "a" Or s = "b" Then
d(,3) = s(,3)
d(,4) = s(,4)
' or d(,3).Resize(,19) = s(,3).Resize(,19) ' .Value optional
Set d = d.Offset(1) ' move to next row
End If
Next
There are easier ways to do that without VBA. For example Power Query, PivotTable, Copy Link and Table Filter, Data tab > From Access, etc.

Inserting new row of data in excel, every time user click on command button

I have started learning VBA programming and thought of creating one small application for inserting student details into an Excel sheet.
In one Excel sheet named "Main", I have created a form to take user inputs and in another sheet named "Database" I am trying to insert a row of records every time a user clicks the button.
I am successfully able to insert one row of data i.e. first row of data in the database sheet, but my problem is - I want to go to the next row in the sheet once user enters the record and clicks on the button a second time. Similarly for the third time and so on.
My code is:
Private Sub CommandButton1_Click()
Dim i As String
Dim j As String
Dim k As String
Dim l as integer
i = Sheets("Main").Cells(1, 2).Value
j = Sheets("Main").Cells(2, 2).Value
k = Sheets("Main").Cells(3, 2).Value
Sheets("Main").Cells(1, 2).Value = ""
Sheets("Main").Cells(2, 2).Value = ""
Sheets("Main").Cells(3, 2).Value = ""
l=2
Sheets("Database").Cells(l, 1).Value = i
Sheets("Database").Cells(l, 2).Value = j
Sheets("Database").Cells(l, 3).Value = k
End Sub
I want to increment value of l by 1, every time user clicks on the command button so that the new record is inserted into the next row of the Database sheet.
We can get the last row of a particular column by :-
dstRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
Private Sub CommandButton1_Click()
Dim i As String
Dim j As String
Dim k As String
Dim m As String
i = Sheets("Main").Cells(1, 2).Value
j = Sheets("Main").Cells(2, 2).Value
k = Sheets("Main").Cells(3, 2).Value
m = Sheets("Main").Cells(4, 2).Value
Sheets("Main").Cells(1, 2).Value = ""
Sheets("Main").Cells(2, 2).Value = ""
Sheets("Main").Cells(3, 2).Value = ""
Sheets("Main").Cells(4, 2).Value = ""
dstRw = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("Database").Cells(dstRw, 1).Value = i
Sheets("Database").Cells(dstRw, 2).Value = j
Sheets("Database").Cells(dstRw, 3).Value = k
Sheets("Database").Cells(dstRw, 4).Value = m
End Sub
Thanks :-
Nitish Gaurav
Quite confused about what is you want. How is the user inputting the next row? Also at the top of your code (where you assign values to i,j and k) you are iterating the row and essentially copying a column, not a row.
I'll try to answer the remainder of your question as best I can. To make VBA know how to copy data to the next row you can do this:
Sub test()
i = "John"
j = "25"
k = "Male"
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Cells(lastRow + 1, 1) = i
Cells(lastRow + 1, 2) = j
Cells(lastRow + 1, 3) = k
End Sub
Try running that a couple of times in a row and you'll see how it works. If I misunderstood please clarify what you want.

Error 13 when Pasting from another Workbook

I'm new to VBA, and I've been trying to paste some data from one file into my active file. Unfortunately, I've been getting error 13 - Type Mismatch. I've tried changing each of the variable definitions, even declaring them as Variant, but nothing helped. The most relevant part of the code is below, with the error between the asterisks.
dim i, j, k, CompShtStartNum, CompShtQty as integer
dim OldFile as variant
dim WCompWS, WCOl, NumEntryCol, ShtName as string
dim InputsSht as worksheet
dim NumEntryColRange, OldEntryCount as range
'Paste data from Entry Label columns into comparison sheets
'Paste in the data from the old file
For i = CompShtStartNum To CompShtStartNum + CompShtQty - 1
ShtName = ThisWorkbook.Sheets(i).Name
Set OldSht = OldFile.Sheets(ShtName)
Set OldEntryCount = Range(OldSht.Cells(2, 1), OldSht.Cells(Rows.Count, 1).End(xlDown))
For j = 1 To CompShtStartNum - i + 1
For k = 1 To InputsSht.Range(WCol & 12 + j - 1).Value
If OldFile.Sheets(i).Cells(1, k).Value = Sheets(i).Cells(1, k).Value Then
***Sheets(i).Cells(2, k).Resize(OldEntryCount.Rows.Count, 1).Value = Application.Transpose(OldEntryCount.Value)***
End If
Next k
Next j
Next i
For context, here is the full code:
Set OldFile = Application.Workbooks("Old Input File.xlsx")
Let WCompWS = "E"
Let WCol = "F"
Let CompShtStartNum = 2
Set InputsSht = ThisWorkbook.Sheets("Inputs")
Let CompShtQty = InputsSht.Range(WCompWS & 12, InputsSht.Range(WCompWS & 12).End(xlDown)).Count
'Loop thru each sheet and have the user determine the last column of labels. Paste result on Inputs sheet.
For i = CompShtStartNum To CompShtStartNum + CompShtQty - 1
ShtName = ThisWorkbook.Sheets(i).Name
Sheets(ShtName).Activate
NumEntryCol = Application.InputBox("How many columns (from the left-hand side) contain entry labels?" & vbNewLine & "(Examples of entry labels: Library #, Entry #, etc.)" & vbNewLine & vbNewLine & "Please type your answer numerically.", ShtName)
InputsSht.Range(WCol & 12 + i - CompShtStartNum).Value = NumEntryCol
Next i
Set NumEntryColRange = InputsSht.Range(WCol & 12, InputsSht.Range(WCol & 12).End(xlDown))
InputsSht.Activate
'Paste data from Entry Label columns into comparison sheets
'Paste in the data from the old file
For i = CompShtStartNum To CompShtStartNum + CompShtQty - 1
ShtName = ThisWorkbook.Sheets(i).Name
Set OldSht = OldFile.Sheets(ShtName)
Set OldEntryCount = Range(OldSht.Cells(2, 1), OldSht.Cells(Rows.Count, 1).End(xlDown))
For j = 1 To CompShtStartNum - i + 1
For k = 1 To InputsSht.Range(WCol & 12 + j - 1).Value
If OldFile.Sheets(i).Cells(1, k).Value = Sheets(i).Cells(1, k).Value Then
***Sheets(i).Cells(2, k).Resize(OldEntryCount.Rows.Count, 1).Value = Application.Transpose(OldEntryCount.Value)***
End If
Next k
Next j
Next i
Any help or suggestions would be very appreciated!!
However, the result was only the value in A2 being pasted into A2:A7 on the active file sheet. How can I get each of the values in A2:A7 to paste into their respective cells on my active sheet?
Try this
Sheets(i).Cells(2, k).Resize(OldEntryCount.Rows.Count, 1).Value = _
OldEntryCount.Value
Here is a short demonstration. Let's say our worksheet looks like this
Now lets say we want the values of A1:A5 in B1:B5 in Sheet1
Simply try this
Sub Sample()
Dim OldEntryCount As Range
With ThisWorkbook.Sheets("Sheet1")
Set OldEntryCount = .Range("A1:A5")
.Range("B1").Resize(OldEntryCount.Rows.Count, 1).Value = _
OldEntryCount.Value
End With
End Sub
And you will get the result