Results 1 to 8 of 8

Thread: inserting ranges of data to a worksheet from an array

  1. #1

    inserting ranges of data to a worksheet from an array



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I have some code whereby I populate an array, from a range on a worksheet, and then I need to put the data from the array, to another sheet, placed in groups 5 columns across, by a varying length of rows, and if there is more than 5 columns wide of data, then the data must be placed on the new worksheet, at 43 row separations...
    Please note that I am transposing the data from on to the other, rows to columns.. On the new data, there would be 43 rows separating the start of each group, of 5 columns. At this point I'm just trying to work it out, on one sheet, and then I will make it work, with the two sheets.

    The problem is working out, once I write 5 columns across, I need to move down 43 rows, and write the next 5 column of data, and so on and there is mi dilemma...
    Help if you can, Thanks...

    SAMPLE DATA
    Date Time 8.16 3.48 2.75 3.18 15.79 5
    8/5/2015 3:19:37 PM 8.1373 3.3875 2.7724 3.3585 15.808 5.0009
    8/5/2015 3:21:28 PM 8.1492 3.4937 2.7708 3.3452 15.8069 5.0012
    8/5/2015 3:23:06 PM 8.136 3.4505 2.7691 3.3383 15.807 5.005
    8/5/2015 3:33:01 PM 8.1542 3.4806 2.7679 3.2655 15.8078 5.0024
    8/5/2015 3:39:56 PM 8.135 3.4716 2.7665 3.2777 15.7988 5.0056
    8/5/2015 3:44:52 PM 8.144 3.4932 2.7722 3.3497 15.8026 5.0023
    8/5/2015 3:48:05 PM 8.1385 3.4793 2.7674 3.2643 15.7908 5.0039
    8/5/2015 3:53:26 PM 8.1514 3.4612 2.7712 3.324 15.8093 5.0029
    8/5/2015 3:56:08 PM 8.1544 3.4911 2.7678 3.2809 15.8019 5.0048
    8/5/2015 3:59:54 PM 8.1424 3.4632 2.7707 3.344 15.8005 5.0039
    8/5/2015 4:07:52 PM 8.1624 3.4233 2.7714 3.3501 15.8031 5.0046
    8/5/2015 4:09:14 PM 8.1318 3.4634 2.7682 3.3245 15.8076 5.0041
    8/5/2015 4:09:58 PM 8.1501 3.4592 2.7685 3.2704 15.8211 5.006
    8/5/2015 4:10:40 PM 8.1318 3.4877 2.7708 3.3064 15.8018 5.0019
    8/5/2015 4:11:20 PM 8.1529 3.4898 2.768 3.3058 15.808 4.9994
    8/5/2015 4:12:37 PM 8.143 3.3846 2.7705 3.3301 15.81 5.0089
    8/5/2015 4:13:31 PM 8.1229 3.4711 2.7682 3.2531 15.8068 4.9938
    8/5/2015 4:14:55 PM 8.121 3.4874 2.7667 3.2967 15.8119 5.0036
    8/5/2015 4:15:39 PM 8.151 3.5079 2.7701 3.317 15.8011 5.0059
    8/5/2015 4:17:29 PM 8.1307 3.414 2.7684 3.2765 15.8121 5.0029


    NEW DATA
    8.1373 8.1492 8.136 8.1542 8.135 8.144
    3.3875 3.4937 3.4505 3.4806 3.4716 3.4932
    2.7724 2.7708 2.7691 2.7679 2.7665 2.7722
    3.3585 3.3452 3.3383 3.2655 3.2777 3.3497
    15.808 15.8069 15.807 15.8078 15.7988 15.8026
    5.0009 5.0012 5.005 5.0024 5.0056 5.0023



    8.1385 8.1514 8.1544 8.1424 8.1624 8.1318
    3.4793 3.4612 3.4911 3.4632 3.4233 3.4634
    2.7674 2.7712 2.7678 2.7707 2.7714 2.7682
    3.2643 3.324 3.2809 3.344 3.3501 3.3245
    15.7908 15.8093 15.8019 15.8005 15.8031 15.8076
    5.0039 5.0029 5.0048 5.0039 5.0046 5.0041




    8.1501 8.1318 8.1529 8.143 8.1229 8.121
    3.4592 3.4877 3.4898 3.3846 3.4711 3.4874
    2.7685 2.7708 2.768 2.7705 2.7682 2.7667
    3.2704 3.3064 3.3058 3.3301 3.2531 3.2967
    15.8211 15.8018 15.808 15.81 15.8068 15.8119
    5.006 5.0019 4.9994 5.0089 4.9938 5.0036




    8.151 8.1307 8.1399 8.1256
    3.5079 3.414 3.4537 3.3937
    2.7701 2.7684 2.7725 2.7665
    3.317 3.2765 3.3193 3.2916
    15.8011 15.8121 15.81 15.8022
    5.0059 5.0029 5.0024 5.0061


    Code:
    Sub ImportData()
    Dim DataRng
    Dim DataArray() As Variant
    
    With ActiveSheet
    
        On Local Error Resume Next
        Application.DisplayAlerts = False
        Set DataRng = Application.InputBox(prompt:="Select a Range", Type:=8)
        Application.DisplayAlerts = True
        Workbooks(DataRng.Parent.Parent.Name).Activate
        Sheets(DataRng.Parent.CodeName).Activate
        DataRng.Select
     
    DataArray = Range(DataRng.Address)
    Dim R As Long
    Dim C As Long
    Dim Ri As Long
    Dim Ci As Long
    Ri = 14
    Ci = 9
    For R = 1 To UBound(DataArray, 1) ' First DataArray dimension is rows.
        For C = 1 To UBound(DataArray, 2) ' Second DataArray dimension is columns.
            Cells(Ri, Ci) = (DataArray(R, C))
            Ri = Ri + 1
        Next C
        Ci = Ci + 1
        Ri = 14
        Next R
    
    End With

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    supercrewed, this is a cross post (you have posted the same query elsewhere) without including links to where you have done so.
    Please have a careful read of http://www.excelguru.ca/content.php?184 to understand why this important, then make the necessary additions of links to all sites/threads.
    Ultimately, supercrewed, it will be to your benefit.

    To others, I would prefer if people considering responding to this thread would delay doing so until supercrewed has complied.

    Edit: supercrewed has now complied.
    Last edited by p45cal; 2015-08-15 at 03:11 AM.

  3. #3
    Thank you I didn't know.. I wasn't getting a response from the other forum above link, so I posted it her as well. I have developed a solution that works, but it's not pretty, and the code is slow. May I post the new code, and see if it can be improved?

    I am unable to add a link to my post on MrExcel forum, your site won't let me, once again I didn't know this was an issue.
    Last edited by supercrewed; 2015-08-15 at 02:41 AM. Reason: Added note

  4. #4
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    Quote Originally Posted by supercrewed View Post
    Thank you I didn't know.. I wasn't getting a response from the other forum above link, so I posted it her as well. I have developed a solution that works, but it's not pretty, and the code is slow. May I post the new code, and see if it can be improved?
    Sure

    Quote Originally Posted by supercrewed View Post
    I am unable to add a link to my post on MrExcel forum, your site won't let me, once again I didn't know this was an issue.
    There are ways; post 3 more rubbish posts to get past the 5 needed or just miss off the http://www bit of the link thus:
    mrexcel.com/forum/excel-questions/875153-writing-array-data-ranges.html

    but here's a proper link:
    http://www.mrexcel.com/forum/excel-q...ta-ranges.html

  5. #5
    Just in case you're interested in looking at it, here's the code that works, but I don't like the switching between sheets to make it work, using the copy, and pastespecial... I wanted to do it completely from the array, but I was unable to get the code to work.



    Code:
    Public Sub OpenData()                 '''<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< IMPORT CSV FILE
    
    
    Application.DisplayAlerts = False
      
      FileToOpen = Application.GetOpenFilename _
    (Title:="Select File to Import", _
    FileFilter:="Comma Seperated Values *.csv (*.csv),")
    ''
    If FileToOpen = False Then
     Exit Sub
    Else
     Workbooks.Open Filename:=FileToOpen
    End If
    
    
    WorkbookName = ActiveWorkbook.Name
    
    
    ImportData
    End Sub
    Sub ImportData()
    Dim DataRng
    Dim DataArray() As Variant
    
    
    With ActiveSheet
    
    
        On Local Error Resume Next
        Application.DisplayAlerts = False
        Set DataRng = Application.InputBox(prompt:="Select a Range", Type:=8)
        Application.DisplayAlerts = True
        Workbooks(DataRng.Parent.Parent.Name).Activate
        Sheets(DataRng.Parent.CodeName).Activate
        DataRng.Select
     
    DataArray = Range(DataRng.Address)
    Dim R As Long
    Dim c As Long
    Dim Ri As Long
    Dim Ci As Long
    
    
    Ri = 1
    Ci = 9
    
    
    For R = 1 To UBound(DataArray, 1)
        For c = 1 To UBound(DataArray, 2)
            Cells(Ri, Ci) = (DataArray(R, c))
            Ri = Ri + 1
        Next c
    Ci = Ci + 1
    Ri = 1
    Next R
    End With
    
    
    CopyPasteData
    End Sub
    Sub CopyPasteData()
    
    
    Dim c, i, x As Long
    Dim Lrow, Lcol  As Long
    
    
    Windows(WorkbookName).Activate
    
    
    With ActiveSheet
    'Find Last Row
    Lrow = .Range("I" & Rows.Count).End(xlUp).Row
    'Find Last Column
    Lcol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    
    
    i = 9
    x = 14
    For i = 9 To Lcol
    
    
    Windows(WorkbookName).Activate
    Range(Cells(1, i), Cells(Lrow, i + 4)).Select
    Selection.Copy
    
    
    Windows("PullMatic Inspection Report.xlsm").Activate
    Cells(x, 9).Select
    Sheets("Dimensional Results").PasteSpecial xlPasteValuesAndNumberFormats
    
    
    x = x + 43
    i = i + 4
     Next i
    CloseNoSave
    End Sub

  6. #6
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    I'm coming up against several unknowns.
    1. Could you attach 2 real csv files or more. If there is sensitive data either do some search and replacing first, or Private Message me here asking for my email address so you can send them there.
    2. Is the PullMatic Inspection Report.xlsm the same file as that which the code is in? (I want to use ThisWorkbook)
    3. Which workbook is the sheet Dimensional Results in?
    4. When the user is asked to select a range - what does he usually select? The whole data on the sheet?, some table? - does it include headers? (I'm trying to automate that selection so that I can at least try to pre-select the area for the user, if not take the user out of that part altogether.)
    5. Why are you wanting this 43 row separation. Perhaps it is to do with printing?

    To whet your appetite, here's a snippet of code which operates entirely on the active sheet. Select the area of interest before running:
    Code:
    Sub blah()
    Set scedata = Selection
    Set Destn = Range("o14")  'this is where the first block of data will be placed (I14 originally).
    For rw = 1 To scedata.Rows.Count Step 5
      'scedata.Rows(rw).Resize(5).Select
      'Destn.Resize(scedata.Columns.Count, 5).Select
      scedata.Rows(rw).Resize(5).Copy
      Destn.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Set Destn = Destn.Offset(43)
    Next rw
    End Sub
    Please address all points 1 to 5 without skipping over any.
    Last edited by p45cal; 2015-08-15 at 12:35 PM.

  7. #7
    Thanks P45cal, i'll give that a go...

  8. #8
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    375
    Articles
    0
    Excel Version
    2020
    Code:
    Sub M_snb()
      sn = Split(Join(Filter(Filter(Filter(Split(Join(Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\__snb_book.csv").readall, vbLf), "Date", False), " " & vbLf & " ")), "/", False), ":", 0), "M", False)), " " & vbLf & " ")
      
      sheet1.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
      sheet1.Columns(1).TextToColumns , 1, , , , 0, 0, -1, 0
    
      For j = UBound(sn) - 4 To 6 Step -5
        sheet1.Rows(j).Resize(5).Insert
      Next
    
      For Each ar In sheet1.Columns(1).SpecialCells(2).Areas
         With ar.CurrentRegion
            .Offset(, .Columns.Count + 2).Resize(.Columns.Count, .Rows.Count) = Application.Transpose(.Value)
         End With
      Next
    End Sub

    You only have to adapt "G:\__snb_book.csv"

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •