Me again... I've got some code that copies cells from a certain column (from sheet "Convertor") and pastes it into a different column (sheet "Unallocated"). These values (IDs) are then used as a reference point to move the rest of the cells for each row (record) into the correct position I need it in.
However I can't get the code to continuously copy the IDs into a blank row so that they don't overwrite the previous set. I think it's something to do with the line Master.Cells(rowB, colB) = yourData but I can't figure it out. I tried changing the rowB to be the same xlUp to find the last unused cell in the column (as with lastA = Slave.Cells(Rows.Count, colA).End(xlUp).Row), but I couldn't get it to work. Any ideas?
Current code:
Private Sub CommandButton21_Click()
Dim colA As Integer, colB As Integer
Dim rowA As Integer, rowB As Integer
Dim Master As Worksheet, Slave As Worksheet 'declare both
Application.ScreenUpdating = False
Set Master = ThisWorkbook.Worksheets("Unallocated")
Set Slave = ThisWorkbook.Worksheets("Convertor")
colA = 17
colB = 29
rowA = 1
rowB = 1
lastA = Slave.Cells(Rows.Count, colA).End(xlUp).Row 'This finds the last row of the data of the column FROM which i'm copying
For x = rowA To lastA 'Loops through all the rows of A
yourData = Cells(x, colA)
Master.Cells(rowB, colB) = yourData
rowB = rowB + 1 'Increments the current line of destination workbook
Next x 'Skips to next row
For j = 1 To 5000 '(the master sheet)
For i = 1 To 5000 '(the slave sheet) 'for first 1000 cells
If Trim(Master.Cells(j, 29).Value2) = vbNullString Then Exit For 'if ID cell is blank exit
If Master.Cells(j, 29).Value = Slave.Cells(i, 17).Value Then
If IsEmpty(Slave.Cells(i, 3)) Then Exit Sub
Master.Cells(j, 2).Value = Slave.Cells(i, 3).Value 'Move all other data based on the ID
Master.Cells(j, 8).Value = Slave.Cells(i, 4).Value
Master.Cells(j, 9).Value = Slave.Cells(i, 5).Value
Master.Cells(j, 10).Value = Slave.Cells(i, 6).Value
Master.Cells(j, 11).Value = Slave.Cells(i, 7).Value
Master.Cells(j, 12).Value = Slave.Cells(i, 8).Value
Master.Cells(j, 13).Value = Slave.Cells(i, 9).Value
Master.Cells(j, 4).Value = Slave.Cells(i, 10).Value
Master.Cells(j, 23).Value = Slave.Cells(i, 11).Value
Master.Cells(j, 24).Value = Slave.Cells(i, 12).Value
Master.Cells(j, 25).Value = Slave.Cells(i, 13).Value
Master.Cells(j, 26).Value = Slave.Cells(i, 14).Value
Master.Cells(j, 27).Value = Slave.Cells(i, 15).Value
Master.Cells(j, 28).Value = Slave.Cells(i, 16).Value
If Not IsEmpty(Slave.Cells(i, 3)) Then _
Slave.Cells(i, 3).EntireRow.Delete 'deletes row after it has been copied
End If
Next
Next
Application.ScreenUpdating = True
End Sub
Let's start with a simple loop copying data for each row. Then you can add in your checks.
You can use worksheet.range to write to cells (column row) such as ("A4") or ("A" & counter).
Private Sub CommandButton21_Click()
Dim ws As Excel.Worksheet
Dim wsMaster As Excel.Worksheet
Dim strValue As String
Set ws = ActiveWorkbook.Sheets("Convertor")
Set wsMaster = ActiveWorkbook.Sheets("Unallocated")
'Count of row to read from
Dim lRow As Long
lRow = 1
'Count of row to write to
Dim jRow As Long
jRow = 1
ws.Activate
'Loop through and copy what is in the rows
Do While lRow <= ws.UsedRange.Rows.count
wsMaster.Range("AC" & jRow).Value = ws.Range("Q" & lRow).Value
wsMaster.Range("B" & jRow).Value = ws.Range("C" & lRow).Value
wsMaster.Range("H" & jRow).Value = ws.Range("D" & lRow).Value
wsMaster.Range("I" & jRow).Value = ws.Range("E" & lRow).Value
wsMaster.Range("J" & jRow).Value = ws.Range("F" & lRow).Value
wsMaster.Range("K" & jRow).Value = ws.Range("G" & lRow).Value
wsMaster.Range("L" & jRow).Value = ws.Range("H" & lRow).Value
wsMaster.Range("M" & jRow).Value = ws.Range("I" & lRow).Value
wsMaster.Range("D" & jRow).Value = ws.Range("J" & lRow).Value
wsMaster.Range("W" & jRow).Value = ws.Range("K" & lRow).Value
wsMaster.Range("X" & jRow).Value = ws.Range("L" & lRow).Value
wsMaster.Range("Y" & jRow).Value = ws.Range("M" & lRow).Value
wsMaster.Range("Z" & jRow).Value = ws.Range("N" & lRow).Value
wsMaster.Range("AA" & jRow).Value = ws.Range("O" & lRow).Value
wsMaster.Range("AB" & jRow).Value = ws.Range("P" & lRow).Value
ws.Rows(lRow).EntireRow.Delete
'Increment counters for both sheets. We can actually use just one counter, but if there is ever a condition that will cause us to not copy a row, then we will need two counters.
jRow = jRow + 1
'lRow = lRow + 1 'This is commented out because we are deleting rows after we copy them.
Loop
End Sub
If you really need to delete the rows after they are copied then we will have to not increment the lRow value.
.Cells is Limiting your approach.
Consider Change to Using Range("A1:C3000") notation it's more powerful.
Range.Select
Range.Paste (to new High mark for UsedRows.Count at destination)
Also unless you have exactly 5000 rows, it's not that accurate,
experiment with
ActiveSheet.UsedRange.Rows.Count
Related
Using a userform, I have created an 'Update' function to the form to make amendments to certain rows of data.
For some reason, when I make an amendment and click on the 'Update' button, the data from columns T, P and W are randomly added to Sheet1 instead of Sheet2.
Private Sub Update_Click()
Dim selectedRow As Long
'Make Sheet2 active
Sheet2.Activate
Dim x As Range
Set WS = Worksheets("Data")
selectedRow = Application.WorksheetFunction.Match(CLng(Me.SN.Value), WS.Range("A:A"), 0)
'Transfer information
Cells(selectedRow, 3).Value = hour.Value & ":" & minute.Value & " " & ampm.Value
Cells(selectedRow, 4).Value = PTID.Value
Cells(selectedRow, 2).Value = cmbdate.Value & "/" & cmbmonth.Value & "/" & cmbyear.Value
Cells(selectedRow, 5).Value = UNIT.Value
Cells(selectedRow, 6).Value = PCBOX.Value
Cells(selectedRow, 7).Value = WASTE.Value
Cells(selectedRow, 8).Value = REPORTED.Value
Cells(selectedRow, 9).Value = DETBOX.Value
Cells(selectedRow, 10).Value = FOLBOX.Value
Cells(selectedRow, 11).Value = SUMBOX.Value
Cells(selectedRow, 12).Value = CAPBOX.Value
Cells(selectedRow, 13).Value = EHOR.Value
Cells(selectedRow, 14).Value = TECHS.Value & "," & TECHS2.Value & "," & TECHS3.Value & "," & TECHS4.Value
Cells(selectedRow, 15).Value = ERRORBOX.Value
Cells(selectedRow, 16).Value = PREVBOX.Value
Cells(selectedRow, 17).Value = SOP.Value
Cells(selectedRow, 18).Value = AUDIFILE.Value
Cells(selectedRow, 19).Value = INTERFILE.Value
Cells(selectedRow, 20).Value = cmbdate2.Value & "/" & cmbmonth2.Value & "/" & cmbyear2.Value
Cells(selectedRow, 23).Value = Phase.Value
Cells(selectedRow, 24).Value = QIM.Value
MsgBox "Entry updated, please check your entry.", , "Entry Update"
End Sub
The problem seems to occur with the lines for columns, 16, 20 and 23 (which refer to the PREVBOX, dates, and Phase values respectively. Attached below is an image of the stray cells being copied to Sheet1 cells highlighted in yellow (and effectively overwriting any cells on that sheet).
The rows and columns also match the rows and columns of the data on Sheet2 but I'm not sure if the cells are being overwritten in Sheet2 which is the intention of the update button.
The table contains column G = City, H = Department and J = Date. In the columns J Date some values are missing. I want to output these rows on a new worksheet with (column A) the rownumber, (column B) the city and (column) the departement.
The code I have looks like this but in the output all rows with a value in J = Date and the output is in the columns "G, H, J". I tried to change the columns in the code but I failed.
Sub missing()
Dim ws, wsOut As Worksheet
Set ws = ActiveWorkbook.Sheets("Table1")
Set wsOut = ActiveWorkbook.Sheets("output")
lastRow = ws.Range("G" & Rows.Count).End(xlUp).Row
lastRowOut = wsOut.Range("G" & Rows.Count).End(xlUp).Row + 1
For i = 1 To lastRow
If (ws.Cells(i, 10).Value = "") _
And _
((ws.Cells(i, 7).Value = "Peking") Or _
(ws.Cells(i, 7).Value = "Tokio") Or _
(ws.Cells(i, 7).Value = "London") Or _
(ws.Cells(i, 7).Value = "Rom") Or _
(ws.Cells(i, 7).Value = "Lissabon") Or _
(ws.Cells(i, 7).Value = "Panama") Or _
(ws.Cells(i, 7).Value = "Budapest") Or _
(ws.Cells(i, 7).Value = "Prag") Or _
(ws.Cells(i, 7).Value = "Dublin") Or _
(ws.Cells(i, 7).Value = "Luxemburg")) _
And _
((ws.Cells(i, 8).Value = "A") Or _
(ws.Cells(i, 8).Value = "B") Or _
(ws.Cells(i, 8).Value = "C") Or _
(ws.Cells(i, 8).Value = "D") Or _
(ws.Cells(i, 8).Value = "E") Or _
(ws.Cells(i, 8).Value = "F") Or _
(ws.Cells(i, 8).Value = "G") Or _
(ws.Cells(i, 8).Value = "H") Or _
(ws.Cells(i, 8).Value = "I") Or _
(ws.Cells(i, 8).Value = "J")) _
Then
wsOut.Range("B" & lastRowOut & ":C" & lastRowOut).Value = ws.Range("G" & i & ":H" & i).Value
wsOut.Range("A" & lastRowOut).Value = i
lastRowOut = lastRowOut + 1
End If
Next i
End Sub
while i was writing this others have answered and honestly I like there solution but can also be done like this:
Sub missing()
Dim ws, wsOut As Worksheet
Set ws = ActiveWorkbook.Sheets("table")
Set wsOut = ActiveWorkbook.Sheets("output")
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
lastRowOut = wsOut.Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 2 To lastRow
If ws.Cells(i, 3).Value = "" Then
wsOut.Range("A" & lastRowOut & ":B" & lastRowOut).Value = ws.Range("A" & i & ":B" & i).Value
wsOut.Range("C" & lastRowOut).Value = i
lastRowOut = lastRowOut + 1
End If
Next i
End Sub
assuming table is in worksheet "table" and output is wanted in a worksheet called "output" [note output has to have a value somewhere in column A before the code is run or an error will be thrown]
Also the code you show does not appear to be trying to answer the question you've asked, it may just be that you took a wrong turn but it is quite different, let us know if we've all missed the point!
Click on cell "A1", press Ctrl+G and choose "Special", "current region" (that should select the whole array). Again press Ctrl+G and choose "Special", this type choose "Blanks".
In the address bar, type "No Date".
Press Ctrl+ENTER (don't forget the control-button).
You can record this into a macro.
Have fun :-)
Oh, by the way, this is wrong:
If Cells(i, 1).Value = "Peking" Or "Tokio" Or "London" Or ...
It should be something like:
If Cells(i, 1).Value = "Peking" Or_
Cells(i, 1).Value = "Tokio" Or_
...
(The underscore after "Or" is just to explain VBA that this should be treated as one single line.)
Not sure i'm 100% with you, but
Dim r as range
dim c as range
dim a() as variant
dim i as long
set r=range("c2:c22").specialcells(xlcelltypeblanks)
redim a(1 to r.cells.count,1)
i=1
for each c in r.cells
a(i,0) = cells(c.row,1)
a(i,1)=cells(c.row,2)
i=i+1
next c
' Output, to j1 on the same sheet.
cells(1,10).resize(ubound(a),2).value=a
I'm trying to make a macro which calls other macros (like the one below) and applies them to specified sheets.
I think the problem is that my previously made macros in which it calls upon isn't coded correctly to be applied to sheets it's not actively on.
Here is my code:
Sub limits_Monitoring_bores()
Dim sht As Worksheet, lastRow As Long
Set sht = ActiveWorkbook.Worksheet
'Name columns appropriately
With ActiveWorkbook.Worksheets(1)
.Cells(1, 4).Value = "Min"
.Cells(1, 5).Value = "Max"
.Cells(1, 7).Value = "20th Percentile"
.Cells(1, 8).Value = "80th Percentile"
.Cells(1, 10).Value = "20th Percentile"
.Cells(1, 11).Value = "80th Percentile"
End With
lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
sh.Range("D2:D" & lastRow).Value = "=6"
sh.Range("E2:E" & lastRow).Value = "=8.5"
sh.Range("G2:G" & lastRow).Value = "=PERCENTILE(F:F,0.2)"
sh.Range("H2:H" & lastRow).Value = "=PERCENTILE(F:F,0.8)"
sh.Range("J2:J" & lastRow).Value = "=PERCENTILE(I:I,0.2)"
sh.Range("K2:K" & lastRow).Value = "=PERCENTILE(I:I,0.8)"
Do While Cells(i, 1).Value <> ""
....
End If
i = i + 1
Loop
End Sub
Right. It works fine with numbers and stop perfectly. But With Text. It does not stop.
Ideally I want to stop at the last row of my content rather than my last row in Excel. I manage to make it work fine with numbers, but I cannot fix it with Text.
Any help would be great as I am a beginner in VBA.
Sub checkRoutine()
Dim i As Integer
Dim LastRow As Long
i = 1
Do While Cells(i, 1).Value <> ""
If IsNumeric(Cells(i, 1).Value) Then Cells(i, 2).Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
If Not IsNumeric(Cells(i, 1).Value) Then
LastRow = Range("A" & Rows.Count).End(xlUp).row + 1
ActiveSheet.Cells(LastRow, "A").Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
End If
i = i + 1
Loop
End Sub
As suggested by so many people, you need to change to use a For loop:
Sub checkRoutine()
Dim i As Long
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).row
For i = 1 To LastRow
If IsNumeric(Cells(i, 1).Value) Then
Cells(i, 2).Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
Else
LastRow = Range("A" & Rows.Count).End(xlUp).row + 1
Cells(LastRow, "A").Value = Cells(i, 1).Value & " " & Cells(7, 5).Value
End If
Next
End Sub
i have several workbooks which get copy from one master workbook. what i want to do is when i enter data into the master workbook, i want to copy it into another workbook based on product type which i get fromn Combobox1.Value. to be more clear, which workbooks i want to copy the data depends on the ComboBox1.value. ie if the ComboBox1.value equals to "Penofix" then i want to copy the data into the workbook "Penofix.xlsm". i have finish coding on master input on how to enter data into particular row based on some condition but facing problem to copy the data into another workbooks.
Private Sub CmdEnter_Click()
Dim CountRow As Long
Dim i As Long
Dim prod as string
Dim j As Long
Dim Ws As Worksheet
Dim Count1 as Long
'CountRow is number of row in master workbook
CountRow = Worksheets("Input").Range("B" & Rows.Count).End(xlUp).Row
'assign variable prod with combobox1 value
prod = ComboBox1.Value
'i=32 because my row start at 32
For i = 32 To countRow + 31
While ComboBox1.Value = Worksheets("Input").Cells(i, 2).Value
Rows(i).Select
Selection.Insert shift = xlDown
With Worksheets("Input")
'insert data into master workbook
.Range("B" & i) = ComboBox1.Text
.Range("C" & i) = TextBox1.Text
.Range("D" & i) = TextBox2.Text
.Range("E" & i) = TextBox3.Text
.Range("F" & i) = TextBox4.Text
.Range("G" & i) = TextBox5.Text
.Range("H" & i) = ComboBox2.Text
.Range("I" & i) = TextBox6.Text
.Range("J" & i) = TextBox7.Text
.Range("K" & i) = TextBox8.Text
End With
'activate other workbook to copy data,if prod = Penofix,the workbook will be "Penofix.xlsm"
workbooks(prod & ".xlsm").Activate
'count the number of row in workbooks(prod & ".xlsm").
' i specified cell (31,3) to calculate the number of row used
Count1 = Workbooks(prod & ".xlsm").Worksheets("Sheet1").Cells(31,3).Value
Count1 = Count1 + 31
'copy data into workbooks(prod & ".xlsm")
'THIS IS THE LINE WHICH ERROR
Workbooks(prod & ".xlsm").Worksheets("Input").Range(Cells(Count1, 2), Cells(Count1 , 11)).Value = Workbooks("Master.xlsm").Worksheets("Input").Range(Cells(i, 2), Cells(i, 11)).Value
If MsgBox("One record written to Input. Do you want to continue entering data?", vbYesNo)= vbYes Then
ComboBox1.Text = ""
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""
ComboBox2.Text = ""
TextBox6.Text = ""
TextBox7.Text = ""
TextBox8.Text = ""
Else
Unload Me
End If
Exit Sub
Wend
Next
End Sub
i've try to replace
Workbooks(prod & ".xlsm").Worksheets("Input").Range(Cells(Count1, 2), Cells(Count1 , 11)).Value = Workbooks("Master.xlsm").Worksheets("Input").Range(Cells(i, 2), Cells(i, 11)).Value
with this
Workbooks(prod & ".xlsm").Worksheets("Input").Cells(Count1, 2).Value = Workbooks("Master.xlsm").Worksheets("Input").Cells(i, 2).Value
and yeah its work but it just for one singe cell only. so i think the error is on the syntax :
Range(Cells(Count1,2), Cells(Count1,11))
but i dont know how to make it to copy the entire row
Workbooks("Master.xlsm").Worksheets("Input").Range(cells(i,B).cells(i,K)).Value = _
Workbooks(prod & ".xlsm").).Worksheets("Sheet1").Range(Cells(CountRow, B). Cells(CountRow, K)).Value
This code will update the master workbook, I doubt you want to this. Also there is a syntax error with .). and then some.
I think this is what you need:
Dim sht1 As Worksheet, sht2 As Worksheet
Set sht1 = Workbooks(prod & ".xlsm").Worksheets("Sheet1")
Set sht2 = Workbooks("Master.xlsm").Worksheets("Input")
sht1.Range(sht1.Cells(CountRow, 2), sht1.Cells(CountRow, 11)).Value = _
sht2.Range(sht2.Cells(i, 2), sht2.Cells(i, 11)).Value
Imroved code: Using resize(<row>, <column>)
Workbooks(prod & ".xlsm").Worksheets("Sheet1").Cells(CountRow, 2).resize(, 11).Value = _
Workbooks("Master.xlsm").Worksheets("Input").Cells(i, 2).resize(, 11).Value
For some added info, the Cells(<Row>, <Column>) will only take integers in for either <Row> and <Column>. Hence the column B is represented as 2.