My variable value (Excel-VBA) is not getting increased. Please help me. Following are the syntax:
Do
Sheets("PF Data - Monthly").Select
PF_WAGE = PF_WAGE + Range("D" & row_no).Value
PF_EMP = PF_EMP + Range("E" & row_no).Value
PF_367 = PF_367 + Range("F" & row_no).Value
PF_833 = PF_833 + Range("G" & row_no).Value
row_no = row_no + 1
Loop Until Range("A" & row_no).Value = AC_NO
A simple With can help you make all the difference.
Then, inside the With you need to qualify all Range objects, by adding a .. i.e. .Range("D" & row_no).Value
Code
row_no=1
With Sheets("PF Data - Monthly")
Do
PF_WAGE = PF_WAGE + .Range("D" & row_no).Value
PF_EMP = PF_EMP + .Range("E" & row_no).Value
PF_367 = PF_367 + .Range("F" & row_no).Value
PF_833 = PF_833 + .Range("G" & row_no).Value
row_no = row_no + 1
Loop Until .Range("A" & row_no).Value = AC_NO
End With
Try this out
dim row_no as long
dim ws as worksheet
Set ws = ThisWorkBook.Worksheets("PF Data - Monthly")
row_no = 1 ' initialize it
Do
PF_WAGE = PF_WAGE + ws.Range("D" & row_no).Value
PF_EMP = PF_EMP + ws.Range("E" & row_no).Value
PF_367 = PF_367 + ws.Range("F" & row_no).Value
PF_833 = PF_833 + ws.Range("G" & row_no).Value
row_no = row_no + 1
Loop Until ws.Range("A" & row_no).Value = AC_NO
You have to ad this line to your code: row_no = 1 because row_no by default has the value of zero.
row_no = 1
Do
Sheets("PF Data - Monthly").Select
PF_WAGE = PF_WAGE + Range("D" & row_no).Value
PF_EMP = PF_EMP + Range("E" & row_no).Value
PF_367 = PF_367 + Range("F" & row_no).Value
PF_833 = PF_833 + Range("G" & row_no).Value
row_no = row_no + 1
Loop Until Range("A" & row_no).Value = AC_NO
End Sub
Related
I'm trying to get all possible combinations with a kind of VBA macro presented in https://stackoverflow.com/a/10693789/1992004, but get an error For without Next. I compared the source from another thread with mine, but don't found such difference, which could cause this error.
Do you see, what causes this error? - please point me to. My Code follows.
Option Explicit
Sub Sample()
Dim l As Long, m As Long, n As Long, o As Long, p As Long, q As Long, r As Long, s As Long, t As Long, u As Long
Dim CountComb As Long, lastrow As Long
Range("L2").Value = Now
Application.ScreenUpdating = False
CountComb = 0: lastrow = 18
For l = 1 To 1: For m = 1 To 2
For n = 1 To 2: For o = 1 To 18
For p = 1 To 15: For q = 1 To 10
For r = 1 To 10: For s = 1 To 17
For t = 1 To 3: For u = 1 To 3
Range("L" & lastrow).Value = Range("A" & l).Value & "/" & _
Range("B" & m).Value & "/" & _
Range("C" & n).Value & "/" & _
Range("D" & o).Value & "/" & _
Range("E" & p).Value & "/" & _
Range("F" & q).Value & "/" & _
Range("G" & r).Value & "/" & _
Range("H" & s).Value & "/" & _
Range("I" & t).Value & "/" & _
Range("J" & u).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
Next: Next
Next: Next
Range("L1").Value = CountComb
Range("L3").Value = Now
Application.ScreenUpdating = True
End Sub
All the comments above explain your problem, but this is what your code would look like with proper indenting AND the missing "next" statements:
For l = 1 To 1
For m = 1 To 2
For n = 1 To 2
For o = 1 To 18
For p = 1 To 15
For q = 1 To 10
For r = 1 To 10
For s = 1 To 17
For t = 1 To 3
For u = 1 To 3
Range("L" & lastrow).Value = Range("A" & l).Value & "/" & _
Range("B" & m).Value & "/" & _
Range("C" & n).Value & "/" & _
Range("D" & o).Value & "/" & _
Range("E" & p).Value & "/" & _
Range("F" & q).Value & "/" & _
Range("G" & r).Value & "/" & _
Range("H" & s).Value & "/" & _
Range("I" & t).Value & "/" & _
Range("J" & u).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
At the very least, it would have made it immediately obvious where your code was failing.
I have created a macro that consolidates rows that contain the same value in column D and provides the average of the rows consolidated. I am trying to write a line of code inside the code provided below, which will count the individual rows that have been consolidated and paste the result next to the consolidated row (column Q) as it can be sheen form the pictures. Picture 1 contains the initial table and picture 2 contains the consolidated table.
any ideas? Much appreciated!
UPDATE!
These are the updated pictures
The whole process is PERFECT until the row Q (it was the last column before the update). I added three more columns to the destination table and one more to the source table.. if it is possible, I want for the column R the macro to consolidate the rows and print their averaged Gross WFR delivered to the column R ONLY if the column I of the row is 0. Also, I want the macro to count these rows (containing 0) that it consolidates (just like it does for column Q) and print the number in column S. Finally, IF it is possible to count the number of these rows (containing 0) that are out of TARGET and print the number in column K. what I mean by out of TARGET is that for these rows K(values)-E(values)>3%.
FINAL UPDATE OF THE CODE
Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = Sheets("1")
With ws
lastrow = .Cells(.Rows.Count, "D").End(xlUp).Row 'get last row in Column D
Set dataRng = .Range("D2:D" & lastrow) 'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'uniques data from Column D
.Range("Q2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":P" & i).Formula = "=SUMIF($D$2:$D$" & lastrow & ",$M" & i & ",E$2:E$" & lastrow & ")/" & dic(.Range("M" & i).Value)
.Range("R" & i).Formula = "=IF(INDEX($I$2:$I$" & lastrow & ",MATCH($M" & i & ",$D$2:$D$" & lastrow & ",0))=0,N" & i & ",0)"
.Range("S" & i).Formula = "=IF(INDEX($I$2:$I$" & lastrow & ",MATCH($M" & i & ",$D$2:$D$" & lastrow & ",0))=0,Q" & i & ",0)"
.Range("T" & i).Formula = "=IF($S" & i & ">0,SUMPRODUCT(($D$2:$D$" & lastrow & "=$M" & i & ")*(($J$2:$J$" & lastrow & "-$E$2:$E$" & lastrow & ")>3%)),0)"
Next i
.Range("N" & i & ":T" & i).Formula = "=SUM(N2:N" & cnt + 1 & ")"
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value
End With
Try this:
Sub Demo()
Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = ThisWorkbook.Sheets("Sheet4") 'change Sheet4 to your data sheet
Application.ScreenUpdating = False
With ws
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'get last row in Column D
Set dataRng = .Range("D2:D" & lastRow) 'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'uniques data from Column D
.Range("Q2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items) 'count of shipment
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":P" & i).Formula = "=SUMIF($D$2:$D$" & lastRow & ",$M" & i & ",E$2:E$" & lastRow & ")/" & dic(.Range("M" & i).Value)
Next i
.Range("N2:P" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value = .Range("N2:S" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value
End With
Application.ScreenUpdating = True
End Sub
Assumption: Your data is in range Column D:ColumnG and want output in Column M:ColumnQ.
EDIT :
Sub Demo()
Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet4 to your data sheet
Application.ScreenUpdating = False
With ws
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'get last row in Column D
Set dataRng = .Range("D2:D" & lastRow) 'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'uniques data from Column D
.Range("Q2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":P" & i).Formula = "=SUMIF($D$2:$D$" & lastRow & ",$M" & i & ",E$2:E$" & lastRow & ")/" & dic(.Range("M" & i).Value)
.Range("R" & i).Formula = "=IF(INDEX($I$2:$I$" & lastRow & ",MATCH($M" & i & ",$D$2:$D$" & lastRow & ",0))=0,N" & i & ","""")"
.Range("S" & i).Formula = "=IF(INDEX($I$2:$I$" & lastRow & ",MATCH($M" & i & ",$D$2:$D$" & lastRow & ",0))=0,Q" & i & ","""")"
.Range("T" & i).Formula = "=IF(ISNUMBER($S" & i & "),SUMPRODUCT(($D$2:$D$" & lastRow & "=$M" & i & ")*(($K$2:$K$" & lastRow & "-$E$2:$E$" & lastRow & ")>3%)),"""")"
Next i
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value
End With
Application.ScreenUpdating = True
End Sub
EDIT 2 :
Instead of
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row).Value
write
.Range("N" & i & ":T" & i).Formula = "=SUM(N2:N" & cnt + 1 & ")"
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value
EDIT 3 :
Sub Demo_SO()
Dim ws As Worksheet
Dim dataRng As Range
Dim dic As Variant, arr As Variant
Dim cnt As Long
Set ws = ThisWorkbook.Sheets("Sheet5") 'change Sheet4 to your data sheet
Application.ScreenUpdating = False
With ws
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row 'get last row in Column D
Set dataRng = .Range("D2:D" & lastRow) 'range for Column D
Set dic = CreateObject("Scripting.Dictionary")
arr = dataRng.Value
For i = 1 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
Next
.Range("M2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.keys) 'uniques data from Column D
.Range("Q2").Resize(dic.Count, 1) = Application.WorksheetFunction.Transpose(dic.items)
cnt = dic.Count
For i = 2 To cnt + 1
.Range("N" & i & ":P" & i).Formula = "=SUMIF($D$2:$D$" & lastRow & ",$M" & i & ",E$2:E$" & lastRow & ")/" & dic(.Range("M" & i).Value)
.Range("R" & i).Formula = "=IF(INDEX($I$2:$I$" & lastRow & ",MATCH($M" & i & ",$D$2:$D$" & lastRow & ",0))=0,N" & i & ",0)"
.Range("S" & i).Formula = "=IF(INDEX($I$2:$I$" & lastRow & ",MATCH($M" & i & ",$D$2:$D$" & lastRow & ",0))=0,Q" & i & ",0)"
.Range("T" & i).Formula = "=IF($S" & i & ">0,SUMPRODUCT(($D$2:$D$" & lastRow & "=$M" & i & ")*(($K$2:$K$" & lastRow & "-$E$2:$E$" & lastRow & ")>3%)),0)"
Next i
.Range("N" & i & ":T" & i).Formula = "=SUM(N2:N" & cnt + 1 & ")"
.Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value = .Range("N2:T" & .Cells(.Rows.Count, "M").End(xlUp).Row + 1).Value
End With
Application.ScreenUpdating = True
End Sub
I keep getting a Loop without Do every time I run my code and I do not see where I am missing anything or if a loop is misplaced.
I need this code to find key words in specific columns copy then paste them into a summary tab.
Your help would be greatly appreciated.
Sub Summary()
Dim MainLoop As Double
Dim SecondLoop As Double
Dim thirdLoop As Double
Dim Trow As Double
Dim counter As Integer
Dim PSKU As Integer
Dim PDesc As String
Dim PPKG As Integer
Dim CSKU As Integer
Dim CDesc As String
Dim CPKG As Integer
Dim Cstatus As String
MainLoop = 5
SecondLoop = 0
thirdLoop = 0
Trow = 5
counter = 0
Worksheets("final").Activate
Do While MainLoop < ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Final").Activate
ParentSKU = Range("F" & MainLoop).Value
ParentDesc = Range("G" & MainLoop).Value
Worksheets("Summary").Activate
SumRow = (ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row) + 1
Range("A" & SumRow).Value = ParentSKU
Range("B" & SumRow).Value = ParentDesc
Range("C" & SumRow).Value = "Parent"
Worksheets("Final").Activate
Do While SecondLoop < 20
If Range("H" & MainLoop + SecondLoop).Value = "MAT" Or "PKG" Or "ING" Then
Range("F" & MainLoop + SecondLoop).Value = CSKU
Range("G" & MainLoop + SecondLoop).Value = CDesc
Range("H" & MainLoop + SecondLoop).Value = (Cstatus)
Range("I" & MainLoop + SecondLoop).Value = CPKG
Worksheets("Summary").Activate
SumRow = (ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row) + 1
Range("A" & SumRow).Value = CSKU
Range("B" & SumRow).Value = CDesc
Range("C" & SumRow).Value = "Child"
Range("D" & SumRow).Value = CPKG
ElseIf Range("H" & MainLoop + SecondLoop).Value = "WIP" Then
Find = Range("F" & MainLoop + SecondLoop).Value
Do While Trow < ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row & thirdLoop < 20
If Range("J" & Trow).Value = Find Then
If Range("P" & Trow + thirdLoop).Value <> "" Then
CSKU = Range("P" & Trow + thirdLoop).Value
CDesc = Range("Q" & Trow + thirdLoop).Value
Cstatus = Range("R" & Trow + thirdLoop).Value
CPKG = Range("S" & Trow + thirdLoop).Value
Worksheets("Summary").Activate
SumRow = (ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row) + 1
Range("A" & SumRow).Value = CSKU
Range("B" & SumRow).Value = CDesc
Range("C" & SumRow).Value = "Child"
Range("D" & SumRow).Value = CPKG
Worksheets("Final").Activate
thirdLoop = thirdLoop + 1
Trow = Trow + 1
Else
Trow = Trow + 1
End If
Else
thirdLoop = thirdLoop + 1
End If
Loop
End If
SecondLoop = SecondLoop + 1
MainLoop = MainLoop + 20
Loop
Worksheets("Final").Activate
End Sub
The following section is missing an End If
If Range("P" & Trow + thirdLoop).Value <> "" Then
CSKU = Range("P" & Trow + thirdLoop).Value
CDesc = Range("Q" & Trow + thirdLoop).Value
Cstatus = Range("R" & Trow + thirdLoop).Value
CPKG = Range("S" & Trow + thirdLoop).Value
Worksheets("Summary").Activate
SumRow = (ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row) + 1
Range("A" & SumRow).Value = CSKU
Range("B" & SumRow).Value = CDesc
Range("C" & SumRow).Value = "Child"
Range("D" & SumRow).Value = CPKG
Worksheets("Final").Activate
thirdLoop = thirdLoop + 1
Trow = Trow + 1
'missing end if here
Loop
I am running a for...next loop that checking whether entries in a dataset meet a certain condition (in this case IsNA). However, changing the if-then-else conditions within this loop to also check whether a condition is not met seems to break the for/next loop. I receive a Next without For error even though that element of the sub hasn't changed.
I'm lost as to why the it thinks there is no next in the for loop when that part of the code hasn't changed.
--Original Working Code--
Option Explicit
Dim i As Double
Dim a As Range
Public ssht As Worksheet
Public susht As Worksheet
Public mdsht As Worksheet
Public LastRow As Long
Dim testcell As Long
Public Sub MissingDataSetCopy()
'Part Bii
'Find rows with NA error
Application.ScreenUpdating = False
Dim i, j As Integer
j = 4
'Finds current range on Summary worksheet
Set ssht = ThisWorkbook.Worksheets("sandbox")
Set mdsht = ThisWorkbook.Worksheets("MissingData")
Set susht = ThisWorkbook.Worksheets("summary")
'Copies data to sandbox sheet as values
susht.UsedRange.copy
ssht.Range("A1").PasteSpecial (xlPasteValues)
LastRow = ssht.Range("A4").CurrentRegion.Rows.Count
Dim testcell As Double
Dim numchk As Boolean
'For...Next look call ISNUMBER test
For i = 860 To 874
If Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i - 1 & ":G" & i - 1).Value
j = j + 1
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i + 1 & ":G" & i + 1).Value
j = j + 1
End If
Next i
Dim fnd As Variant
Dim rplc As Variant
fnd = "#N/A"
rplc = "=NA()"
mdsht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
End Sub
--Edit to If Statements--
For i = 860 To 874
If Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) And Application.WorksheetFunction.IsNA(ssht.Range("B" & i - 1)) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
If Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) And Not (Application.WorksheetFunction.IsNA(ssht.Range("B" & i - 1))) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i - 1 & ":G" & i - 1).Value
j = j + 1
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
End If
Next i
You need to close the second If block:
For i = 860 To 874
If Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) And Application.WorksheetFunction.IsNA(ssht.Range("B" & i - 1)) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
End If '<-- it was not closed
If Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) And Not (Application.WorksheetFunction.IsNA(ssht.Range("B" & i - 1))) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i - 1 & ":G" & i - 1).Value
j = j + 1
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
End If
Next i
Or alternatively using the ElseIf keyword if the two conditions (at it seems) are excluding each other:
For i = 860 To 874
If Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) And Application.WorksheetFunction.IsNA(ssht.Range("B" & i - 1)) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
ElseIf Application.WorksheetFunction.IsNA(ssht.Range("B" & i)) And Not (Application.WorksheetFunction.IsNA(ssht.Range("B" & i - 1))) Then
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i - 1 & ":G" & i - 1).Value
j = j + 1
mdsht.Range("B" & j & ":H" & j).Value = ssht.Range("A" & i & ":G" & i).Value
j = j + 1
End If
Next i
hopefully someone would be kind enough to point out why this isn't working. Basically via vba a new line is inserted # the last row of a table (Row41), this pushes the last line down (creating a gap within the data) then the last line values are transferred up one row so the blank row is at the bottom.
Now the process works fine except for two of the cell values change randomly, below are the before and after
Before:
Cell(41,B) = 03/10/14
Cell(41,C) = 12345
Cell(41,E) = 3.00
Cell(41,F) = DD
After:
Cell(41,B) = 03/10/14
Cell(41,C) = 12345
Cell(41,E) = 41915
Cell(41,F) = 41915
I've double checked the set ranges and they are as they should be, any ideas? Oh for the code the Specific_Tbl variable is 2
'[Capture table First/Last row number]
int_FirstRow = .Cells(4, "AC").Offset(0, Specific_Tbl)
int_LastRow = .Cells(6, "AC").Offset(0, Specific_Tbl)
'[Insert Blank Row]
.Range("A" & int_LastRow & ":Z" & int_LastRow).Insert shift:=xlDown
'[Set Cell Ranges]
Select Case Specific_Tbl
Case 1
'[Remerge Description]
.Range(.Cells(int_LastRow, "E"), .Cells(int_LastRow, "H")).MergeCells = True
Set rng_Tmp1 = .Range("B" & int_LastRow & ":C" & int_LastRow & ",E" & int_LastRow & ":J" & int_LastRow)
Set rng_Tmp2 = .Range("B" & int_LastRow + 1 & ":C" & int_LastRow + 1 & ",E" & int_LastRow + 1 & ":J" & int_LastRow + 1)
Case 2, 3
Set rng_Tmp1 = .Range("B" & int_LastRow & ":C" & int_LastRow & ",E" & int_LastRow & ":F" & int_LastRow)
Set rng_Tmp2 = .Range("B" & int_LastRow + 1 & ":C" & int_LastRow + 1 & ",E" & int_LastRow + 1 & ":F" & int_LastRow + 1)
End Select
'[Transfer values and clear]
rng_Tmp1.Value = rng_Tmp2.Value
rng_Tmp2.ClearContents
Unfortunately I never discovered why excel vba was unable to deal with the split range like I believed it would. A workaround was done by adding more range variables to deal with each side of the split range.
'[Capture table First/Last row number]
int_FirstRow = .Cells(4, "AC").Offset(0, Specific_Tbl)
int_LastRow = .Cells(6, "AC").Offset(0, Specific_Tbl)
'[Insert Blank Row]
.Range("A" & int_LastRow & ":Z" & int_LastRow).Insert shift:=xlDown
'[Set Cell Ranges]
Select Case Specific_Tbl
Case 1
'[Remerge Description]
.Range(.Cells(int_LastRow, "E"), .Cells(int_LastRow, "H")).MergeCells = True
Set rng_Tmp1 = .Range("B" & int_LastRow & ":C" & int_LastRow)
Set rng_Tmp2 = .Range("B" & int_LastRow + 1 & ":C" & int_LastRow + 1)
Set rng_Tmp3 = .Range("E" & int_LastRow & ":J" & int_LastRow)
Set rng_Tmp4 = .Range("E" & int_LastRow + 1 & ":J" & int_LastRow + 1)
Case 2, 3
Set rng_Tmp1 = .Range("B" & int_LastRow & ":C" & int_LastRow)
Set rng_Tmp2 = .Range("B" & int_LastRow + 1 & ":C" & int_LastRow + 1)
Set rng_Tmp3 = .Range("E" & int_LastRow & ":F" & int_LastRow)
Set rng_Tmp4 = .Range("E" & int_LastRow + 1 & ":F" & int_LastRow + 1)
End Select
'[Transfer values and clear]
rng_Tmp1.Value = rng_Tmp2.Value
rng_Tmp3.Value = rng_Tmp4.Value
rng_Tmp2.ClearContents
rng_Tmp4.ClearContents