Hi I want to make the data in data base below
ID Name Card No
1 A 3
2
2 B 1
3 C 1
2
to be like
ID Name Card No
1 A 3
1 A 2
2 B 1
3 C 1
3 C 2
Using excel macros.. please help thanks :D
Update, my data is like this and the debugger only copy A & B column
Col->A B C D
Row
7 ID Name Address Card No
8 1 A 3
9 2
10 2 B X road 1
11 3 C Y road 1
12 2
How to fix this? please help :( and it started in row 7
Simple but below code will do the work:
Note: Below code assumes your "Column C" do not have any empty cells. If you do please add comment so I can update.
Sub copyPaste()
Dim lastRow As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row '<- Column that there is no empty cells
For i = 1 To lastRow
If Range("A" & i).Value = "" Then
Range("A" & i).Value = Range("A" & i).Offset(-1, 0).Value
End If
If Range("B" & i).Value = "" Then
Range("B" & i).Value = Range("B" & i).Offset(-1, 0).Value
End If
Next
End Sub
UPDATE: Below code will do the same job for all columns in the workbook. Code assumes that in the first row of worksheet you have headers and it is using this information to calculate how many iterations to do for columns.
Sub copyPaste()
Dim lastRow As Long
Dim lastCol As Long
lastRow = Range("C" & Rows.Count).End(xlUp).Row '<- Column that there is no empty cells
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For j = 1 To lastCol
For i = 1 To lastRow
If Cells(i, j).Value = "" Then
Cells(i, j).Value = Cells(i, j).Offset(-1, 0).Value
End If
Next i
Next j
End Sub
Related
I have code that runs through column E (Column C in example below) and searches for any change in data. It then inserts a blank row under that change and loops through the set of data (200-500 rows long).
I want a "copy and paste" feature of the last row of data, before the change, into the newly inserted row.
Before:
Column A
Column B
Column C
Column E
1
2
Sally
5
1
2
Sally
6
1
2
Sally
2
1
2
Chase
1
1
2
Chase
4
1
2
Ben
9
After:
Column A
Column B
Column C
Column E
1
2
Sally
5
1
2
Sally
6
1
2
Sally
2
2
Sally
1
2
Chase
1
1
2
Chase
4
2
Chase
1
2
Ben
9
2
Ben
The code I have has a loop:
Sub CleanUpPart2()
'Insert Rows by column F
'
Dim iRow As Integer, iCol As Integer
Dim oRng As Range
Set oRng = Range("f1")
iRow = oRng.Row
iCol = oRng.Column
Do
'
If Cells(iRow + 1, iCol) <> Cells(iRow, iCol) Then
Cells(iRow + 1, iCol).EntireRow.Insert Shift:=xlDown
iRow = iRow + 2
Else
iRow = iRow + 1
End If
'
Loop While Not Cells(iRow, iCol).Text = ""
'
Edited::
Try the updated code, please:
Sub testInsertRowCopyBefore()
Dim sh As Worksheet, lastRow As Long, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("A" & Rows.count).End(xlUp).row
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = lastRow + 1 To 3 Step -1
If sh.Range("C" & i).Value <> sh.Range("C" & i - 1).Value Then
sh.Range("C" & i).EntireRow.Insert xlUp
sh.Range("B" & i & ":C" & i).Value = sh.Range("B" & i - 1 & ":C" & i - 1).Value
End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Ready..."
End Sub
The above code assumes that "Column A", "Column B" and "Column C" are the headers, which stay on the sheet first row.
Please, test it and send some feedback
I have a code to concatenate three columns in a difference sheet for one cell -
Sheets("Sheet2").Range("D2") = Sheets("Sheet2").Range("A2") &
Sheets("Sheet2").Range("B2") & Sheets("Sheet2").Range("C2")
I want to repeat this cell for n number of time in the excel sheet - not able to do that
Let's suppose that you have stored your numbers in columns A, B, C.
First, use this code to determine last row (1 stands for A column):
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Then use For loop to achieve what you after (1 stands for A column, 2 - B, 3 - C, D - 4):
For i = 1 To lastRow
Cells(i, 4).Value = Cells(i, 1).Value + Cells(i, 2).Value + Cells(i, 3).Value
Next
In this routine n is the last row you want to be filled:
Sub KonKat()
Dim n As Long, i As Long
n = 5
With Sheets("Sheet2")
For i = 2 To n
.Range("D" & i).Value = .Range("A" & i).Value & .Range("B" & i).Value & .Range("C" & i).Value
Next i
End With
End Sub
I have a data set:
ID Name Amount BID BID 2
1 Jack 100 1
1 John 200 *Blank*
2 Tony 300 2
How can I lookup the ID and where the ID is matching look at the BID and find the relating ID value where the ID value has been populated for the same ID. I want the value to appear in BID 2 which is in column 5.
IE John should have a BID of 1 as his ID is 1 like Jacks ID.
I have tried
=vlookup(A2,A2:C5,3,FALSE)
I honestly don't know a way to do this through formula, but a VBA solution would look like this:
Sub FindTheValue()
Dim sht As Worksheet, lastrow As Long, i As Long, j As Long
Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "C").End(xlUp).Row
For i = 1 To lastrow
If Range("Z" & i).Value = "" Then
For j = 1 To lastrow
If Range("C" & i).Value = Range("C" & j).Value And Range("Z" & j).Value <> "" Then
Range("AA" & i).Value = Range("Z" & j).Value
Exit For
End If
Next j
End If
Next i
End Sub
My main problem is that I am trying to add a row directly beneath another row based on the time value of that row. Here's an example of what I'm trying to do:
column F ========> new column F
2 1
2
2 1
2
1 1
1 1
2 1
2
To better explain, if the value in the first column F is a 2, that represents a time value that is greater than 0:59:00 and another row is added beneath it. If it is a 1, then it represents a time value that is equal to or less than 0:59:00and no row gets added.
I have multiple coding attempts at fixing this, and this first one is by someone more well-versed in VBA than I and includes some of his comments:
Public Sub ExpandRecords()
Dim i As Long, _
j As Long, _
LR As Long
'set variable types
LR = Range("A" & Rows.Count).End(xlUp).Row
'setting variable LR as number of rows with data
Application.ScreenUpdating = False
Columns("F:F").NumberFormat = "hh:mm:ss"
'sets number format in column b to text
For i = LR To 1 Step -1
'Executes following code from last row with data to row 1 working backwards
'If CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)) > 0 Then
If CLng(Hour(Range("F" & i))) > 0 Then
'If the hour value in column F is greater than 1, then...
With Range("F" & i)
'starting with column F, loop through these statements...
'.Offset(1, 0).Resize(CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)) - 1, 1).EntireRow.Insert Shift:=xlDown
.Offset(1, 0).Resize(CLng(Hour(Range("F" & i))).Value, Len(Range("F" & i).Value) - 1, 1).EntireRow.Insert Shift:=xlDown
'return the value of column F's hour value, change the range to insert the number of rows below based on hour value
'.Resize(CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)), 1).EntireRow.Value = Range("A" & i).EntireRow.Value
.Resize(Hour(Range("F" & i)), 1).EntireRow.Value = Range("A" & i).EntireRow.Value
'Get value of row to be copied
'For j = 0 To CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6))
For j = 0 To Hour(Range("F" & i))
Range("H" & i).Offset(j - 1, 0).Value = Application.Text(j, "0")
Next j
End With
Else
Range("H" & i).Value = Application.Text(1, "0")
End If
Next i
Application.ScreenUpdating = True
End Sub
Here is a similar question from a previous user
Any help would be greatly appreciated.
Use this instead:
Public Sub ExpandRecords()
Dim i As Long, s As String
Const COL = "F"
For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
If Cells(i, COL) = 2 Then s = s & "," & Cells(i, COL).Address
Next
If Len(s) Then
Range(Mid$(s, 2)).EntireRow.Insert
For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
If Cells(i, COL) = vbNullString Then Cells(i, COL) = 1
Next
End If
End Sub
If in a cell of a table of data contains a value x > 1, I would like to copy and paste the row containing that cell "x" number of times. The rows would paste with x = 1 in the next available blank row.
TREVDAN 2
CENTRAL 3
GAL FAB 1
From this.
TREVDAN 1
TREVDAN 1
CENTRAL 1
CENTRAL 1
CENTRAL 1
GAL FAB 1
To looking something like this.
This will work for you.
Sub SpecialCopy()
'Assuming A and B columns source columns
Dim i As Long, k As Long
Dim j As Long: j = 1
For i = 1 To Cells(Cells.Rows.Count, 1).End(xlUp).Row
k = 1
Do While k <= Range("B" & i).Value
'Assuming C and D are destination columns
Range("C" & j).Value = Range("A" & i).Value
Range("D" & j).Value = 1
j = j + 1
k = k + 1
Loop
Next i
End Sub
Building off of the answer provided by #Jeanno, you can use the following if you want to paste the results directly over the top of the original table:
Sub SpecialCopy()
'Assuming A and B columns source columns
Dim i As Long, k As Long
Dim j As Long: j = 1
Dim ArrayLength As Long: ArrayLength = Application.WorksheetFunction.Sum(ActiveSheet.Range("B:B"))
ReDim MyArray(1 To ArrayLength) As String
For i = 1 To Cells(Cells.Rows.Count, 1).End(xlUp).Row
k = 1
Do While k <= Range("B" & i).Value
MyArray(j) = Range("A" & i).Value
j = j + 1
k = k + 1
Loop
Next i
For Each MyCell In Range("a1:a" & ArrayLength)
MyCell.Value = MyArray(MyCell.Row())
MyCell.Offset(0, 1).Value = 1
Next MyCell
End Sub