A disjoint named range into an array, then into a string on another sheet

I am trying to get data sent from an endless range into a row on a separate sheet. Before I built the non-contiguous range, this code worked fine. I tried several things to get through, but nothing I tried would work. He will not copy range data when he is sitting. It has been many years since I actually did some coding, and my retraining curve seems to hold me back ... the logic just doesn't fit 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 
+6
source share
1 answer

This is an example to explain how to achieve what you want. Please make changes to the code according to your needs.

Say I have Sheet1 , which looks like below. Colored cells make up from my disjoint range.

enter image description here

Now paste the code below in the 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

We hope that the above example will help you achieve what you want.

+5
source

Source: https://habr.com/ru/post/973977/


All Articles