Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Non-contiguous named range into an array, then into row in different sheet

Tags:

arrays

excel

vba

I'm trying to get data posted from a non-contiguous range into a row in a separate sheet. Before I built the non-contiguous range, this code worked perfectly. I've tried several things to loop through, but nothing I tried will work. It won't copy the ranged data as it sits. It's been years since I've actually done any coding and my re-learning curve seems to be holding me back.... the logic just isn't coming to me. Help!

Sub UpdateLogWorksheet()

Dim historyWks As Worksheet
Dim inputWks As Worksheet

Dim nextRow As Long
Dim oCol As Long

Dim myCopy As Range
Dim myTest As Range
Dim myData As Range

Dim lRsp As Long

Set inputWks = Worksheets("Input")
Set historyWks = Worksheets("DataEntry")
oCol = 3 'order info is pasted on data sheet, starting in this column

'check for duplicate VIN in database
If inputWks.Range("CheckVIN") = True Then
  lRsp = MsgBox("VIN already in database. Update record?", vbQuestion + vbYesNo, "Duplicate VIN")
  If lRsp = vbYes Then
    UpdateLogRecord
  Else
    MsgBox "Please change VIN to a unique number."
  End If

Else

  'cells to copy from Input sheet - some contain formulas

  Set myCopy = inputWks.Range("VehicleEntry") 'non-contiguous named range

  With historyWks
      nextRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
  End With

  With inputWks
      'mandatory fields are tested in hidden column
      Set myTest = myCopy.Offset(0, 2)

      If Application.Count(myTest) > 0 Then
          MsgBox "Please fill in all the cells!"
          Exit Sub
      End If
  End With

  With historyWks
      'enter date and time stamp in record
      With .Cells(nextRow, "A")
          .Value = Now
          .NumberFormat = "mm/dd/yyyy hh:mm:ss"
      End With
      'enter user name in column B
      .Cells(nextRow, "B").Value = Application.UserName
      'copy the vehicle data and paste onto data sheet

      myCopy.Copy
      .Cells(nextRow, oCol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
      Application.CutCopyMode = False
  End With

  'clear input cells that contain constants
  Clear
End If

End Sub
like image 690
Greg Avatar asked Aug 18 '14 14:08

Greg


1 Answers

This is an example to explain how to achieve what you want. Please amend the code to suit your needs.

Let's say, I have a Sheet1 which looks like as shown below. The colored cells make up from my non contiguous range.

enter image description here

Now paste the code given below in a module and run it. The output will be generated in Sheet2 and Sheet3

Code

Sub Sample()
    Dim rng As Range, aCell As Range
    Dim MyAr() As Variant
    Dim n As Long, i As Long
    
    '~~> Change this to the relevant sheet
    With Sheet1
        '~~> Non Contiguous range
        Set rng = .Range("A1:C1,B3:D3,C5:G5")
        
        '~~> Get the count of cells in that range
        n = rng.Cells.Count
        
        '~~> Resize the array to hold the data
        ReDim MyAr(1 To n)
        
        n = 1
        
        '~~> Store the values from that range into
        '~~> the array
        For Each aCell In rng.Cells
            MyAr(n) = aCell.Value
            n = n + 1
        Next aCell
    End With
    
    '~~> Output the data in Sheet
    
    '~~> Vertically Output to sheet 2
    Sheet2.Cells(1, 1).Resize(UBound(MyAr), 1).Value = _
    Application.WorksheetFunction.Transpose(MyAr)
    
    '~~> Horizontally Output to sheet 3
    Sheet3.Cells(1, 1).Resize(1, UBound(MyAr)).Value = _
    MyAr
End Sub

Vertical Output

enter image description here

Horizontal Output

enter image description here

Hope the above example helps you in achieving what you want.

like image 84
Siddharth Rout Avatar answered Nov 09 '22 04:11

Siddharth Rout