PDA

View Full Version : [SOLVED] Help to modify VBA Code



shido
02-18-2015, 01:59 PM
Hi All,

I appreciate if anyone can help me. I have a VBA code in the "downloaded report". If I run it, the code will copy "pivot table look like" sheet and paste in the same workbook by creating a new sheet. This works great and have no issue.

In addition, I also want to save this data in the last available row of another workbook called "Master Data" and add week # in the first column. The week # can be taken from the downloaded report.

I have attached both workbook for reference. Please advice.

Regards

Sha

1286712868

Bob Phillips
02-19-2015, 04:40 AM
Sub test()
Dim sh As Worksheet
Dim shData As Worksheet
Dim shMaster As Worksheet
Dim data, result, production, igroup, article, vl
Dim rowMasterLast As Long, rowsData As Long
Dim lrow As Long, i As Long, j As Long, n As Long, k As Integer

If IsError(Evaluate("'Downloaded report'!A1")) Then Exit Sub

Set sh = Sheets("Downloaded report")
With sh

lrow = .UsedRange.Rows.Count
If lrow < 10 Then Exit Sub

data = .Range("b1:o" & lrow)

ReDim result(1 To lrow, 1 To 14)

result(1, 1) = data(2, 4)
result(2, 1) = data(4, 5)
result(3, 1) = "week#"
result(4, 1) = "Date"
result(3, 2) = data(8, 14)
result(4, 2) = Format(data(9, 14), "[$-10407]dd-mm")

For Each vl In Array(1, 6, 7, 9, 11, 12, 13)

k = k + 1
result(6, k) = data(9, vl)
Next
result(6, k + 1) = "Qty"

j = 6
For i = 10 To lrow

If data(i, 1) <> "" Then production = data(i, 1)
If data(i, 6) <> "" Then igroup = data(i, 6)
If data(i, 7) <> "" Then

article = data(i, 7)
j = j + 1
result(j, 1) = production
result(j, 2) = igroup
result(j, 3) = article
k = 3
For Each vl In Array(9, 11, 12, 13, 14)

k = k + 1
result(j, k) = data(i, vl)
Next
End If
Next
End With

Application.ScreenUpdating = False

Set shMaster = Workbooks("Master Data.xls").Worksheets("Master Data")
rowMasterLast = shMaster.Range("A1").End(xlDown).Row

Set shData = Worksheets.Add
With shData

rowsData = j - 6

.Range("a1:h" & j) = result

.Range("a1,a3,a4,b4, a6:h6").Font.Bold = 1
.Range("a3:b4").HorizontalAlignment = xlCenter
.Range("a6:h" & j).Borders.LineStyle = xlContinuous
.Range("a6:h" & j).Columns.AutoFit

.Cells(7, "A").Resize(rowsData, 8).Copy shMaster.Cells(rowMasterLast + 1, "B")
shMaster.Cells(rowMasterLast + 1, "A").Resize(rowsData).Value = .Range("B3").Value
shMaster.Rows(rowMasterLast).Copy
shMaster.Cells(rowMasterLast + 1, "A").Resize(rowsData).PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyModemode = False
Application.ScreenUpdating = True
End Sub

p45cal
02-19-2015, 04:49 AM
beaten to it by xld!
Master Data.xls should already be open.

Sub test()
Dim sh As Worksheet, NewSht As Worksheet, lrow As Long, data, result, i As Long, j As Long, production, igroup, article, n As Long, k As Integer, vl
Dim DestnSht As Worksheet, DestnCell As Range

If IsError(Evaluate("'Downloaded report'!A1")) Then Exit Sub
Set sh = Sheets("Downloaded report")
lrow = sh.UsedRange.Rows.Count
If lrow < 10 Then Exit Sub

data = sh.Range("b1:o" & lrow)
ReDim result(1 To lrow, 1 To 14)

result(1, 1) = data(2, 4)
result(2, 1) = data(4, 5)
result(3, 1) = "week#"
result(4, 1) = "Date"
result(3, 2) = data(8, 14)
result(4, 2) = Format(data(9, 14), "[$-10407]dd-mm")

For Each vl In Array(1, 6, 7, 9, 11, 12, 13)
k = k + 1
result(6, k) = data(9, vl)
Next

result(6, k + 1) = "Qty"
j = 6
For i = 10 To lrow
If data(i, 1) <> "" Then production = data(i, 1)
If data(i, 6) <> "" Then igroup = data(i, 6)
If data(i, 7) <> "" Then
article = data(i, 7)
j = j + 1
result(j, 1) = production
result(j, 2) = igroup
result(j, 3) = article
k = 3
For Each vl In Array(9, 11, 12, 13, 14)
k = k + 1
result(j, k) = data(i, vl)
Next
End If
Next

Application.ScreenUpdating = 0

Set NewSht = Sheets.Add
With NewSht
.Range("a1:h" & j) = result
.Range("a1,a3,a4,b4, a6:h6").Font.Bold = 1
.Range("a3:b4").HorizontalAlignment = xlCenter
.Range("a6:h" & j).Borders.LineStyle = xlContinuous
.Range("a6:h" & j).Columns.AutoFit
Set DestnSht = Workbooks("Master Data.xls").Sheets("Master Data")
With DestnSht
Set DestnCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
.Range("a7:h" & j).Copy DestnCell.Offset(, 1)
With DestnCell.Resize(j - 6)
.Value = data(8, 14)
.Borders.LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End With
Application.ScreenUpdating = 1
End Sub

shido
02-19-2015, 05:55 AM
WoW.. That's work great.

Just a small changes in the code for added functionality.

Can I put this Code into a Different file and When I run the code, it ask me to pick the source file "downloaded report" to copy data from.

Once it select the source file, rather then creating Worksheet in the "downloaded report", it let me pick First excel file and save in tab "abc". Once its done, it then let me pick second Excel file "master Data" and save in the last available row.

Hope I am not asking too much changes in the above code.

Regards

Sha

Bob Phillips
02-19-2015, 06:53 AM
Who are you directing that at, me or p45cal?

shido
02-19-2015, 07:09 AM
Well I tried both and both code works

anyone can help me if it's okay?

shido
02-19-2015, 11:41 AM
Well Thank you both of you

Second Part i have sorted out myself.

Thank you once again.

Regards

Sha

shido
02-19-2015, 11:44 AM
Well Thank you both of you

Second Part i have sorted out myself.

Thank you once again. but how i can acknowledge your effort ?

Regards

Sha

p45cal
02-19-2015, 11:56 AM
but how i can acknowledge your effort ?You already have, just by replying