Navi_G
Board Regular
- Joined
- May 30, 2018
- Messages
- 94
- Office Version
- 2016
- Platform
- Windows
Hi All Expertise,
i have to make a report multiple times a day and it takes too much time because it has different steps pls provide a VBA code to do it automatically by single key or button. Step wise description:
Step 1. I go to first data sheet select from (C17:AN17) to last data row then copy it and paste in a new worksheet.
Step 2. I select 2nd data sheet from (C21:AN21) to last data row which will be between 1 to 1000, copy it and paste in that sheet where i paste 1st sheet data. (Below that data).
Step 3. Delete Row# 2 & 3.
Step 4. Delete Columns (TOTAL PCS, SHRINKAG, Width, Shade, Balance & all blanks columns).
Step 5. Copy data from (D1:Last data cell) and paste in Row # 2.
Step 6. Delete Row # 01.
Step 7. Insert Filter. Open filter in column C and delete blank rows.
Step 8. Delete column C.
Now I have only that data which I require.
Step 9. Unpivot Columns. (I have VBA code for it)
Step 10. Some cuts have more than on value row assign them numbering. (I have VBA for this
Kindly give VBA coding to remove unnecessary rows and columns and also compile all coding in one.
Data Sheets may be 1 to 15.
Link of my data file is
GU 15436 15437 15542 15543.xlsx
i have already post this question in Excel Forum but enable to get any answer.
Remove Un-Necessary Data by VBA
i have to make a report multiple times a day and it takes too much time because it has different steps pls provide a VBA code to do it automatically by single key or button. Step wise description:
Step 1. I go to first data sheet select from (C17:AN17) to last data row then copy it and paste in a new worksheet.
Step 2. I select 2nd data sheet from (C21:AN21) to last data row which will be between 1 to 1000, copy it and paste in that sheet where i paste 1st sheet data. (Below that data).
Step 3. Delete Row# 2 & 3.
Step 4. Delete Columns (TOTAL PCS, SHRINKAG, Width, Shade, Balance & all blanks columns).
Step 5. Copy data from (D1:Last data cell) and paste in Row # 2.
Step 6. Delete Row # 01.
Step 7. Insert Filter. Open filter in column C and delete blank rows.
Step 8. Delete column C.
Now I have only that data which I require.
Step 9. Unpivot Columns. (I have VBA code for it)
Code:
Sub Rearrange_v2()
Dim a As Variant, b As Variant
Dim i As Long, j As Long, k As Long, uba2 As Long
a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, Cells(1, Columns.Count).End(xlToLeft).Column).Value
uba2 = UBound(a, 2)
ReDim b(1 To UBound(a) * (uba2 - 2), 1 To 4)
For i = 2 To UBound(a)
For j = 3 To uba2
If Len(a(i, j)) > 0 Then
k = k + 1
b(k, 1) = a(i, 1)
b(k, 2) = a(i, 2)
b(k, 3) = a(1, j)
b(k, 4) = a(i, j)
End If
Next j
Next i
Range("A" & Rows.Count).End(xlUp).Offset(3).Resize(, 4).Value = Array("QTY", "CUT #", "Size", "Bundle")
Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(k, 4).Value = b
End Sub
Code:
Sub Bundles()
Dim vWS As Worksheet
Dim vA, vA2()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long
Set vWS = ActiveSheet
With vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2(1 To vSum, 1 To 4)
vA = .Range("A2:D" & vR)
For vN = 1 To vR - 1
For vN2 = 1 To vA(vN, 4)
vC = vC + 1
For vN3 = 1 To 4
vA2(vC, vN3) = vA(vN, vN3)
Next vN3
Next vN2
Next vN
End With
vC = 1
For vN = 1 To vSum - 2
vA2(vN, 4) = vC
If vA2(vN + 1, 2) = vA2(vN, 2) Then
vC = vC + 1
vA2(vN + 1, 4) = vC
Else
vA2(vN + 1, 4) = 1
vC = 1
End If
Next vN
Application.ScreenUpdating = False
Sheets.Add
With ActiveSheet
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
End With
Application.ScreenUpdating = True
End Sub
Data Sheets may be 1 to 15.
Link of my data file is
GU 15436 15437 15542 15543.xlsx
i have already post this question in Excel Forum but enable to get any answer.
Remove Un-Necessary Data by VBA