PDA

View Full Version : [SOLVED] Do While Method to append data



sbbmaster09
06-06-2016, 12:01 PM
I am able to do this in using one file, how can I insert do while or for loop where the copydata will be merged/append on the final data. I think there is a tweak on the RunCopy code below to be able to append data from one sheet to another. I am not much familiar with do while loops.


Sub RunCopy()Dim i As Long, x As Range


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


With Sheet2
For i = .UsedRange.Columns.Count To 1 Step -1
Set x = Sheet3.Rows(1).Find(.Cells(1, i).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not x Is Nothing Then
.Columns(i).Value = Sheet3.Columns(x.Column).Value
End If
Set x = Nothing
Next i
End With


With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With


End Sub

Attached file for reference. Thanks.

Jacob Hilderbrand
06-06-2016, 01:54 PM
In this example it uses With Sheet2 so anything that starts with a . is on Sheet2. And also uses Sheet3. So it copies from Sheet2 to Sheet3 and columns are processed one at a time. What are you trying to loop?

offthelip
06-06-2016, 04:13 PM
On the assumption that you want append the data to rows below the first set this code will copy the data to subsequent rows. I was looking at the workbook that you sent so I have used those sheet names. plus "Test" the output. Note I haven't defined all the variables, since this is only a suggestion as to how to do it. Note I am using Variant array instead of copy from colunm to column, this should be much faster since every access to the worksheet in EXCEL takes a long time.
I hope this gives you some ideas in solving your problem




Sub Newruncopy()
Dim i As Long, x, lastcell As Range
Dim outarr() As Variant


With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


indi = 0


For dummy = 1 To 2


Worksheets("finaldata").Select
colcnt = Worksheets("finaldata").UsedRange.Columns.Count
With Worksheets("finaldata")
Set lastcell = .Cells(.Rows.Count, "A").End(xlUp)
rowcnt = lastcell.Row
End With
inarr = Range(Cells(1, 1), Cells(rowcnt, colcnt))
ReDim outarr(1 To rowcnt, 1 To colcnt)
Worksheets("Copydata").Select
titles = Range(Cells(1, 1), Cells(1, 14))


For i = 1 To 14
outarr(1, i) = titles(1, i)
For j = 1 To colcnt
If titles(1, i) = inarr(1, j) Then
For k = 2 To rowcnt
outarr(k, i) = inarr(k, j)
Next k
End If
Next j
Next i


Worksheets("test").Select
Range(Cells(1 + indi, 1), Cells(rowcnt + indi, colcnt)) = outarr


indi = indi + rowcnt
Next dummy


With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

sbbmaster09
06-07-2016, 02:26 AM
I will check on this and study, I will give a feedback once done. thanks for this.

sbbmaster09
06-07-2016, 02:39 AM
It's not working for me, it won't append the data from the copy data to the finaldata.

sbbmaster09
06-07-2016, 07:55 AM
I have tried to debug my code, I came up with this code and has a lil error than before. Can someone check where I have done wrong? It seems that i am able to transfer all the data from the copydata tab to the finaldata tab but in a different cell, attached is my file.


Sheet1.Select Range("F" & cnt).Value = RowCount

Sheet2.Select
rn = Sheet2.UsedRange.Rows(Sheet2.UsedRange.Rows.Count).Row

For i = 1 To Sheet2.UsedRange.Columns.Count Step 1
Set x = Sheet3.Rows(1).Find(Sheet2.Cells(1, i).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not x Is Nothing Then
Sheet3.Select
Cells(2, x.Column).Select
Range(Selection, Selection.End(xlDown)).Copy


Sheet2.Select
Cells(rn + 1, i).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End If
Set x = Nothing
Next i

Sheet2.Select
Range("A" & RowCount + 1).Select
Range(Selection, Selection.End(xlUp).Offset(1)).Value = Sheet1.Range("D" & cnt).Value
Sheet1.Select

offthelip
06-07-2016, 09:17 AM
It's not working for me, it won't append the data from the copy data to the finaldata.

the code that I wrote doesn't write out to the Finaldata sheet, it writes the data out to a sheet called "Test" which I added to your workbook for testing. The code just writes the same lines out twice because the data in copydata doesn't change. So this is only part of the solution, but it will append data to rows below, but only with in the loop. I noticed that you have commented out these lines in the workbook you sent back.

Can you clarify what the sequence of events is when you want to append data to the bottom of final data? Is the data in Copydata changing in between calls to this macro? Do you want the macro to determine where to append data to in final worksheet.

In your code you are using "used range" to determine the last row, you will find that the used range is usually much larger than the range which has actually got data in it. I would suggest using the code I used to determine the last cell with data in it. (your variable "rn")

Set lastcell = .Cells(.Rows.Count, "A").End(xlUp)
rowcnt = lastcell.Row

You might find that this solves your problem anyway. It certainly will cause your code to paste the data way beyond the last row with data in it.

sbbmaster09
06-07-2016, 09:45 AM
I finally solved it.


Range("A2").Select RowCount = ActiveSheet.UsedRange.Rows.Count - 1


rn = Sheet2.Range("A1").CurrentRegion.Rows.Count


Sheet2.Select
Range("A" & rn + 1 & ":A" & RowCount + rn).Value = Sheet1.Range("D" & cnt).Value

Sheet1.Select
Range("F" & cnt).Value = RowCount

Sheet2.Select

For i = 1 To Sheet2.UsedRange.Columns.Count Step 1
Set x = Sheet3.Rows(1).Find(Sheet2.Cells(1, i).Value, LookIn:=xlValues, lookat:=xlWhole)
If Not x Is Nothing Then
Sheet3.Select
Cells(2, x.Column).Select
Range(Selection, Selection.End(xlDown)).Copy

Sheet2.Select
Cells(rn + 1, i).Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
End If
Set x = Nothing
Next i