Jump to content
News Ticker
  • Welcome to the Community
  • Use the forum to troubleshoot your Excel & VBA Problems
  • We will be launching a new website soon! www.ExcelWTF.com/Learn ! Join us to learn VBA from the ground up!
  • 0
Sign in to follow this  
Followers 0
Joeslost

Select Case/Assigning Array help needed!

Asked by Joeslost

Question

Joeslost    0

Joeslost
Posted

Hello all! 

My name is Joe and I am going crazy with this issue! 

Background info:

I have a spreadsheet that pulls information from a variable workbook and places it appropriately in a template workbook. Then sorts it deletes and unused data. It really is quite handy.

More on the Making of the initial Macro here: http://www.mrexcel.com/forum/excel-questions/944821-macros-switching-between-two-excel-sheets-out-setnames.html

The Macro code : 

Sub Import_Customer_Information()
Dim Chr(1 To 80) As Integer
Dim X As Integer

'This Makes the macro change without updating the screen with each operation.
  Application.ScreenUpdating = False

'This sets both open workbooks as variables

  Dim wb1 As Workbook, wb2 As Workbook
  Dim answer As Integer

'Ensures There are only 2 workbooks open

  If Workbooks.Count > 2 Then
    MsgBox "You may only have 2 Workbooks Open when running this Macro. Exiting...", vbCritical, "Warning"
    Exit Sub
  End If

  If Workbooks.Count < 2 Then
    MsgBox "You need to have both your customer info sheet and templete file open! Exiting...", vbCritical, "Warning"
    Exit Sub
  End If

' Ensures the contract file is set as wb2 and the other is wb1.

  If ThisWorkbook Is Workbooks(1) Then
    Set wb1 = Workbooks(2)
    Set wb2 = ThisWorkbook
  Else
    Set wb1 = Workbooks(1)
    Set wb2 = ThisWorkbook
  End If
  
'Checks if Acount is Cod or charge and adds it to the contract respectivly.

  wb1.Activate
  Range("AB2").Select
  Selection.Copy
  wb2.Activate
  Range("Q1").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Begins to copy information from one workbook to another
'Moving A/r Number

  wb1.Activate
  Range("A2").Select
  Selection.Copy
  wb2.Activate
  Range("G8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Company Name

  wb1.Activate
  Range("K2").Select
  Selection.Copy
  wb2.Activate
  Range("D9,J3,B13").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Route

  wb1.Activate
  Range("AC2").Select
  Selection.Copy
  wb2.Activate
  Range("J6").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Contact

  wb1.Activate
  Range("Q2").Select
  Selection.Copy
  wb2.Activate
  Range("G10").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Phone

  wb1.Activate
  Range("R2").Select
  Selection.Copy
  wb2.Activate
  Range("G11").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Fax

  wb1.Activate
  Range("T2").Select
  Selection.Copy
  wb2.Activate
  Range("J10").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Email

  wb1.Activate
  Range("S2").Select
  Selection.Copy
  wb2.Activate
  Range("J11").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Service Address

  wb1.Activate
  Range("L2").Select
  Selection.Copy
  wb2.Activate
  Range("B14").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("M2").Select
  Selection.Copy
  wb2.Activate
  Range("B15").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("N2").Select
  Selection.Copy
  wb2.Activate
  Range("B16").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("O2").Select
  Selection.Copy
  wb2.Activate
  Range("D16").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("P2").Select
  Selection.Copy
  wb2.Activate
  Range("G16").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Billing Address

  wb1.Activate
  Range("U2").Select
  Selection.Copy
  wb2.Activate
  Range("J13").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("V2").Select
  Selection.Copy
  wb2.Activate
  Range("J14").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("W2").Select
  Selection.Copy
  wb2.Activate
  Range("J15").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("X2").Select
  Selection.Copy
  wb2.Activate
  Range("J16").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("Y2").Select
  Selection.Copy
  wb2.Activate
  Range("J17").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("Z2").Select
  Selection.Copy
  wb2.Activate
  Range("K17").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

  wb1.Activate
  Range("AA2").Select
  Selection.Copy
  wb2.Activate
  Range("M17").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

' Moveing man Item no

  wb1.Activate
  Range("B2:B82").Select
  Selection.Copy
  wb2.Activate
  Range("B22:B102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moving Desc line 1

  wb1.Activate
  Range("F2:F82").Select
  Selection.Copy
  wb2.Activate
  Range("D22:D102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moves Desc line 2

  wb1.Activate
  Range("G2:G82").Select
  Selection.Copy
  wb2.Activate
  Range("G22:G102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moves Item Inventory

  wb1.Activate
  Range("D2:D82").Select
  Selection.Copy
  wb2.Activate
  Range("H22:H102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moves Weekly Usage

  wb1.Activate
  Range("E2:E82").Select
  Selection.Copy
  wb2.Activate
  Range("J22:J102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moves Weekly Unit Rate

  wb1.Activate
  Range("I2:I82").Select
  Selection.Copy
  wb2.Activate
  Range("K22:K102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moves Min Flat Rate

  wb1.Activate
  Range("H2:H82").Select
  Selection.Copy
  wb2.Activate
  Range("M22:M102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
'Moves Delevery/Fuel Description
    
  wb1.Activate
  Range("AH2").Select
  Selection.Copy
  wb2.Activate
  Range("D104").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
'Moves Delevery Amount
    
  wb1.Activate
  Range("AG2").Select
  Selection.Copy
  wb2.Activate
  Range("M104").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
'Moves Class

  wb1.Activate
  Range("AI2:AI82").Select
  Selection.Copy
  wb2.Activate
  Range("R22:R102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Moves Group

  wb1.Activate
  Range("AD2:AD82").Select
  Selection.Copy
  wb2.Activate
  Range("Q22:Q102").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
'Moves Up Charge Id
  wb1.Activate
  Range("AK2").Select
  Selection.Copy
  wb2.Activate
  Range("R103").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
'Moves  Maintain Inventory Percentage
  wb1.Activate
  Range("AM2").Select
  Selection.Copy
  wb2.Activate
  Range("G103").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

'Adds a zero to each cell In the Group column so items with no group will be on top'

  For Each cell In Range("Q22:Q103")
  If IsEmpty(cell) Then
  cell.Value = 0
  End If
  Next

'Check to see if maintain Inventory line is needed and then calcualte charge generated.

Select Case Range("R103")
  Case "02":
    Range("S21") = "Case 02"
    Per = 0.08
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "03":
    Range("S21") = "Case 03"
    Per = 0.12
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "04":
    Range("S21") = "Case 04"
    Per = 0.05
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "05":
    Range("S21") = "Case 05"
    Per = 0.2
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "06":
    Range("S21") = "Case 06"
    Per = 0.24
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "08":
  Range("S21") = "Case 08"
  Per = 0.32
  For Each cell In Range("R22:R102")
    If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
    Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
    End If
  Next
  
  Case "09":
    Range("S21") = "Case 09"
    Per = 0.12
    For Each cell In Range("R22:R102")
      If cell = "09" Or "14" Then
      cell.Select
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "4A":
    Range("S21") = "Case 4A"
    Per = 0.16
    For Each cell In Range("R22:R102")
        cell.Select
      If cell.Value = "7" Or "9" Or "11" Or "12" Or "13" Or "14" Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case Else:
    Range("S21") = "Case NO"
    Per = 0
    Range("A103").EntireRow.Delete
    GoTo Failed
End Select

Range("S19") = Per

' Assign my arry
Char = Range("S22:S102")

'multiply each entry by a perecentage determined above
For r = LBound(Chr, 1) To UBound(Chr, 1)
  Chr(r) = Chr(r) * Per
Next r

'Place the total of the array in M103

Range("M103").Value = WorksheetFunction.Sum(Chr)

GoTo Finished


Failedcell:
Range("S20") = ("Failedcell")
GoTo DONEXT
Failed:
Range("S20") = ("Failed")
GoTo DONEXT
Finished:
Range("S20") = ("Finished")

DONEXT:
'Unhides the imported information.

  Range("B22:B102").EntireRow.Hidden = False

'Sort the rows based on Group in Column Q, Then off The Man# in Column B.

  Range("B22:S103").Sort key1:=Range("Q22:Q104"), _
  order1:=xlAscending, key2:=Range("B22:B104"), _
  order2:=xlAscending

'Supress Zero Values

  ActiveWindow.DisplayZeros = False

'Deletes any unused line based off of the man# column.

  Dim rng As Range
  Set rng = Range("B22:B102").SpecialCells(xlCellTypeBlanks)
  rng.EntireRow.Delete

'This resets screen updating.
  Application.ScreenUpdating = True

End Sub

 

The new Challenge: I need this macro to also take the total charges for each line and add them all together and multiply them by a percentage and place the total on the another line. the curve balls to this situation are that some times I dont need to do this at all, the percentage is different in many cases  (determined by an identifier code), not all the lines will need to be totaled and calculated, and the lines needed to be totaled and calculated will change depending on the identifier code.

More on why and exactly what here : http://www.mrexcel.com/forum/excel-questions/950379-challenge.html#post4566596

The Code I came up with to solve this situation is this : 

Select Case Range("R103")
  Case "02":
    Range("S21") = "Case 02"
    Per = 0.08
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "03":
    Range("S21") = "Case 03"
    Per = 0.12
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "04":
    Range("S21") = "Case 04"
    Per = 0.05
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "05":
    Range("S21") = "Case 05"
    Per = 0.2
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "06":
    Range("S21") = "Case 06"
    Per = 0.24
    For Each cell In Range("R22:R102")
      If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "08":
  Range("S21") = "Case 08"
  Per = 0.32
  For Each cell In Range("R22:R102")
    If cell.Value = “07” Or “09” Or “11” Or “12” Or “13” Or “14” Then
    Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
    End If
  Next
  
  Case "09":
    Range("S21") = "Case 09"
    Per = 0.12
    For Each cell In Range("R22:R102")
      If cell = "09" Or "14" Then
      cell.Select
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case "4A":
    Range("S21") = "Case 4A"
    Per = 0.16
    For Each cell In Range("R22:R102")
        cell.Select
      If cell.Value = "7" Or "9" Or "11" Or "12" Or "13" Or "14" Then
      Range("S" & ActiveCell.Row).Value = Range("M" & ActiveCell.Row).Value
      End If
    Next
    
  Case Else:
    Range("S21") = "Case NO"
    Per = 0
    Range("A103").EntireRow.Delete
    GoTo Failed
End Select

Range("S19") = Per

' Assign my arry
Char = Range("S22:S102")

'multiply each entry by a perecentage determined above
For r = LBound(Chr, 1) To UBound(Chr, 1)
  Chr(r) = Chr(r) * Per
Next r

'Place the total of the array in M103

Range("M103").Value = WorksheetFunction.Sum(Chr)

GoTo Finished


Failedcell:
Range("S20") = ("Failedcell")
GoTo DONEXT
Failed:
Range("S20") = ("Failed")
GoTo DONEXT
Finished:
Range("S20") = ("Finished")

DONEXT:

 

The Problem: It transfers every value in range in column M to S regardless of whether it equates to true for the If statement. I get no results in M103, so I'm not sure If Chr is established, or if it is multiplied by Per, or if it is even summed.

 

I am completely at a loss why this would not work and any help would be amazing.

 

Thanks in advance,

Joe

Share this post

Link to post
Share on other sites

0 answers to this question

Recommended Posts

There have been no answers to this question yet

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
Sign in to follow this  
Followers 0
Go To Question Listing Excel & VBA Help
×