Conditional value selection , help needed

Sekaran

New Member
Joined
Mar 21, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hello Experts,

Below is my logic to copy/paste and sort data between two excel sheets.

Logic:
  1. Want to copy A2 to D31 in XL “116132” to B16 of “2”
  2. Want to copy I2 to I31 in XL “116132” to F16 of “2”
Till here we bring in all data inside XL we need
  1. Then I need to sort the data in XL “2” based on the condition.
  2. If Part number characters length is 10 then it should remain in its place
  3. If Part number characters length is 8 then it should copy data in that row and paste it from row A48
  4. If Part number characters length is 7 then it should copy data in that row and paste it from row A55

Have written my logics till here and Its not working, also need more coding in sorting the data

7. Deleting the empty row which got copied
8. Also need to write a sub logic where the data gets pasted in next lines for character if length is 8 & 6.

Below is my code:

Sub Engineering()

'If Length of coloumn B is 10
Dim Answer As VbMsgBoxResult
Answer = MsgBox("Are you sure to copy BOM contents?", vbYesNo, "Run Macro")
If Answer = vbYes Then
Workbooks("116132.xlsx").Worksheets("BOM").Range("A2:D31").Copy _
Workbooks("2.xlsx").Worksheets("MPL").Range("B16")
Workbooks("116132.xlsx").Worksheets("BOM").Range("I2:I31").Copy _
Workbooks("2.xlsx").Worksheets("MPL").Range("F16")
Dim Answer1 As Range
For Each Answer1 In Workbooks("2.xlsx").Worksheets("MPL").Range("B16:B45")
If Selection.Len = "10" Then
Next Answer1
If Selection.Len = "8" Then
Workbooks("2.xlsx").Worksheets("MPL").Rows(Selection).Copy _
Workbooks("2.xlsx").Worksheets("MPL").Range("A47")
Next Answer1
If Selection.Len = "6" Then
Workbooks("2.xlsx").Worksheets("MPL").Rows(Selection).Copy _
Workbooks("2.xlsx").Worksheets("MPL").Range("A55")
Next Answer1

End Sub

So basically need help
1. to understand the issue in my current code
2. How to increment the rows while pasting data for condition if character length = 8 & 6

Appreciate any help from this forum. Thanks
 
Hi Zot,

Thanks for suggesting above material & corrected codes, after few iterations have finally derived at what I needed.

Below is the code which works well:

'It is simpler to asign variable.
' In this case I wanted to put macro in workbook 116132 and named it wbSource
Dim rngSource As Range, rngDest As Range, cell As Range
Dim Fname As Variant
Dim rowLast As Long, n6 As Long, n8 As Long
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet

' Need to declare variables.
Set wbSource = ActiveWorkbook
Set wsSource = wbSource.Sheets("BOM") ' If do not want to define wbSource, can simply use Set wsSource = ActiveWorkbook.Sheets("BOM")

' You can open destination workbook (workbook 2) manually but I want to open during runtime
' This code will ask for destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub 'CANCEL is clicked

' Define opened Workbook as wbDest while opening it.
Set wbDest = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbB. Change sheet name accordingly
Set wsDest = wbDest.Sheets("MPL")

' Now I can start copy date from wbSource to wbDest just by using variables. No need to call wbSource and wsSource anymore since rngSource include everything
Set rngSource = wsSource.Range("A2", "D31") ' you can also use Range("A2:D31")
rngSource.Copy wsDest.Range("A16")

' if do not want to define range. can use like this too
wsSource.Range("K2", "K31").Copy wsDest.Range("F16")

' You know you have data in wsDest from B16:B45 since you know you copy from wsSource A2:D31 (total 30 row)
' If you do not want to count, let code find last row
rowLast = wsDest.Range("A" & Rows.Count).End(xlUp).Row ' This simulate selecting last row on column A. Then press Ctrl+ArrowUp. The cursor will stop on last occupied row in column A

' You can now defined range of data is wsDest
Set rngDest = wsDest.Range("B16:B45")
' Instead of using For loop, another option is to use For each loop
n6 = 61
n8 = 46
For Each cell In rngDest
' Using Select Case instead of If statement probably more flexible for multiple conditions
Select Case Len(cell.Value)
Case 6
n6 = n6 + 1 ' row increment
Rows(cell.Row).Cut wsDest.Range("A" & n6)

Case 7, 8
n8 = n8 + 1 ' row increment
Rows(cell.Row).Cut wsDest.Range("A" & n8)

Case 10

End Select
Next


End Sub



Now I'm just trying to invert the selection method, means instead of input sheet as active sheet, trying to write a code by having macro in the output sheet and asking user to select the input excel sheet.

While trying that , the below code works really well in getting all the data from the input sheet, but the sorting is not working great. It tries to pull data from the input sheet again with all columns. or it comes all blank in rows 62 and 47.

Trying to understand what could be done in this case. Appreciate if any help/guidance provided.

'In this case I wanted to put macro in workbook 116132 and named it wbSource
Dim rngSource As Range, rngDest As Range, cell As Range
Dim Fname As Variant
Dim rowLast As Long, n6 As Long, n8 As Long
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet


' Define opened Workbook as wbDest while opening it.
Set wbDest = ActiveWorkbook
' Define working sheet in wbB. Change sheet name accordingly
Set wsDest = wbDest.Sheets("MPL")

' You can open source workbook (workbook 2) manually but I want to open during runtime
' This code will ask for destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub 'CANCEL is clicked

' Need to declare variables.
Set wbSource = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsSource = wbSource.Sheets("BOM") ' If do not want to define wbSource, can simply use Set wsSource = ActiveWorkbook.Sheets("BOM")


' Now I can start copy date from wbSource to wbDest just by using variables. No need to call wbSource and wsSource anymore since rngSource include everything
Set rngSource = wsSource.Range("A2", "D31") ' you can also use Range("A2:D31")
rngSource.Copy wsDest.Range("A16")

' if do not want to define range. can use like this too
wsSource.Range("K2", "K31").Copy wsDest.Range("F16")

' You know you have data in wsDest from B16:B45 since you know you copy from wsSource A2:D31 (total 30 row)
' If you do not want to count, let code find last row
'rowLast = wsDest.Range("A" & Rows.Count).End(xlUp).Row ' This simulate selecting last row on column A. Then press Ctrl+ArrowUp. The cursor will stop on last occupied row in column A

' You can now defined range of data is wsDest
Set rngDest = wsDest.Range("B16:B45")

' Instead of using For loop, another option is to use For each loop
n6 = 61
n8 = 46
For Each cell In rngDest
' Using Select Case instead of If statement probably more flexible for multiple conditions
Select Case Len(cell.Value)
Case 6
n6 = n6 + 1 ' row increment
Rows(cell.Row).Cut wsDest.Range("A" & n6)

Case 7
n8 = n8 + 1 ' row increment
Rows(cell.Row).Cut wsDest.Range("A" & n8)
Case 10

End Select
Next

End Sub
 
Upvote 0

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
I don't understand what you were trying to do
VBA Code:
For Each cell In rngDest
    ' Using Select Case instead of If statement probably more flexible for multiple conditions
    Select Case Len(cell.Value)
        Case 6
            n6 = n6 + 1                                                 ' row increment
           Rows(cell.Row).Cut wsDest.Range("A" & n6)
          
        Case 7
            n8 = n8 + 1                                                 ' row increment
            Rows(cell.Row).Cut wsDest.Range("A" & n8)
        Case 10
      
    End Select
Next

End Sub

The code here to looping rngDest which is
Set rngDest = wsDest.Range("B16:B45")
which means looping from B16 to B45
When code found cell with content = to 6, it will execute
Rows(cell.Row).Cut wsDest.Range("A" & n6)

The Rows above will refers to the active sheet at the time of execution. The reason you defined wsSource, wsDest is to make it easy to reference. It is hard to know which sheets is active at any given time during execution. Therefore, if you want to copy from wsSource, you should state code
wsSource.Rows(cell.Row).Cut wsDest.Range("A" & n6)
 
Upvote 0
Hi Zot,

Perfect !!!! It worked with wsDest.Rows(cell.Row).cut wsDest.Range ().

Thank you so much for your help & guidance.

Sub Eng()

'It is simpler to asign variable.
'In this case I wanted to put macro in workbook 116132 and named it wbSource
Dim rngSource As Range, rngDest As Range, cell As Range
Dim Fname As Variant
Dim rowLast As Long, n6 As Long, n8 As Long
Dim wbSource As Workbook, wbDest As Workbook
Dim wsSource As Worksheet, wsDest As Worksheet


' Define opened Workbook as wbDest while opening it.
Set wbDest = ActiveWorkbook
' Define working sheet in wbB. Change sheet name accordingly
Set wsDest = wbDest.Sheets("MPL")

' You can open source workbook (workbook 2) manually but I want to open during runtime
' This code will ask for destination Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub 'CANCEL is clicked

' Need to declare variables.
Set wbSource = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
Set wsSource = wbSource.Sheets("BOM") ' If do not want to define wbSource, can simply use Set wsSource = ActiveWorkbook.Sheets("BOM")


' Now I can start copy date from wbSource to wbDest just by using variables. No need to call wbSource and wsSource anymore since rngSource include everything
Set rngSource = wsSource.Range("A2", "D31") ' you can also use Range("A2:D31")
rngSource.Copy wsDest.Range("A16")

' if do not want to define range. can use like this too
wsSource.Range("K2", "K31").Copy wsDest.Range("F16")

' You know you have data in wsDest from B16:B45 since you know you copy from wsSource A2:D31 (total 30 row)
' If you do not want to count, let code find last row
'rowLast = wsDest.Range("A" & Rows.Count).End(xlUp).Row ' This simulate selecting last row on column A. Then press Ctrl+ArrowUp. The cursor will stop on last occupied row in column A

' You can now defined range of data is wsDest
Set rngDest = Workbooks("MPL-DPO#.xlsx").Worksheets("MPL").Range("B16:B45")

' Instead of using For loop, another option is to use For each loop
n6 = 61
n8 = 46
For Each cell In rngDest
' Using Select Case instead of If statement probably more flexible for multiple conditions
Select Case Len(cell.Value)
Case 6
n6 = n6 + 1 ' row increment
wsDest.Rows(cell.Row).Cut wsDest.Range("A" & n6)

Case 7, 8
n8 = n8 + 1 ' row increment
wsDest.Rows(cell.Row).Cut wsDest.Range("A" & n8)
Case 10

End Select
Next

End Sub


As a last step, trying to delete the empty rows which got cut in Case 6,7 & 8 scenarios
(Rows within 16 to 45)


I'm sure it should be the last step to be done. Can you please suggest which command would be best?
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top