VBA loop through rows of cells that are selected

Hi,

I have the attached Excel file as sample:

https://dl.dropboxusercontent.com/u/11671679/EE/Sample.xlsx

The sheet "Project" includes 2 named range: Header and Footer that delimitate the area of the table in between. Let's say there are x columns and y rows. x and y are not limited you get to know the area by having Header and Footer that delimitate the table. In case you add or delete rows it should not be affected.

1. I need a macro triggered by button click on the sheet
The macro should run through each row and column and output to file.  

2. If you select in Excel some of the cells in column j
Only the rows that have a selected cell should output to file. Multi-selection should be supported.

3. Output:
Append the cell values in a csv file like:
"John", "Smith", "100", "10-12-2012"

the destination file absolute path can be defined in one of the excel cells on a different sheet named "Configuration" see B1 for example.

4. Alert after work is done should show the number of rows that were processed and after clicking ok on the alert it should un-select the cells in Excel

That's it - it's been a long since I've worked with VBA so I prefer use the Experts on this one!! :)
Sample.xlsx
breezbackAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

[ fanpages ]IT Services ConsultantCommented:
Hi,

Sorry nobody has commented so far.

I understand all of your requirements except point 3).

That is:

3. Output:
Append the cell values in a csv file like:
"John", "Smith", "100", "10-12-2012"

There is no mention of any of these values within the data (between "Header" & "Footer").

Am I to presume that you simply need a record within the file for each selected row (determined by one, or more, selected cells within column [J]), & that each cell on every row will be written "within quotes" separated by a comma?

Also, do you wish the code to use the "Body" named range, or simply use "Header" & "Footer" as the extreme points?

Finally,

the destination file absolute path can be defined in one of the excel cells on a different sheet named "Configuration" see B1 for example.

[B1] presently has the value "C:\output.csv".

If that file already exists, should it be overwritten automatically, or would you like a prompt to be displayed to confirm if overwriting is acceptable (or not)?


Thank you for your clarification.

BFN,

fp.
0
aikimarkCommented:
This code interates the selected cells and outputs the cells in rows of the current region.

Option Explicit

Public Sub Q_28253299()
    Dim rngCR As Range
    Dim rngArea As Range
    Dim rngCell As Range
    Dim vData() As Variant
    Dim vVector() As Variant
    Dim strOut As String
    Dim lngLoop As Long
    Dim intFN As Integer
    intFN = FreeFile
    Open "c:\temp\output.csv" For Output As #intFN
    Set rngCR = ActiveCell.CurrentRegion
    ReDim vVector(1 To rngCR.Columns.Count)
    For Each rngArea In Selection.Areas
        For Each rngCell In rngArea.Rows
            'Debug.Print Intersect(rngCR, rngCell.EntireRow).Address
            vData = Intersect(rngCR, rngCell.EntireRow).Value
            For lngLoop = 1 To UBound(vVector)
                vVector(lngLoop) = vData(1, lngLoop)
            Next
            strOut = Chr(34) & Join(vVector, """,""") & Chr(34)
            Print #intFN, strOut
        Next
    Next
    Close intFN
End Sub

Open in new window

0
breezbackAuthor Commented:
1. Record all the cells in Body to csv - I only used an example in the question

2. If only some of the cells are selected then, record only those rows to csv

3. Take the absolute path from the existing cell in Configuration sheet

4. The output will look like a matrix of all values separated by commas

In fact that's the file is the input to another process in .net

I hope it's clear. :)
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

[ fanpages ]IT Services ConsultantCommented:
Hi,

Further to aikimark's reply, here is my proposal.

The following code is within the Public code module, "basQ_28253299", of the attached workbook.

Option Explicit
Public Sub Q_28253299()

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28253299.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               Q_28253299
' Question Title:   VBA loop through rows of cells that are selected
' Question Asker:   breezback                                 [ http://www.experts-exchange.com/M_3494857.html ]
' Question Dated:   2013-09-30 at 13:39:30
'
' Expert Comment:   fanpages                                   [ http://www.experts-exchange.com/M_258171.html ]
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited                           [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------

  Dim blnContinue                                       As Boolean
  Dim objCell                                           As Range
  Dim objRange                                          As Range
  Dim lngErr_Number                                     As Long
  Dim objFile                                           As Object
  Dim objScripting_FileSystemObject                     As Object
  Dim strErr_Description                                As String
  Dim strFilename                                       As String

  On Error GoTo Err_Q_28253299
  
  blnContinue = True

  Worksheets("Project").Select
  
  strFilename = Trim$(Worksheets("Configuration").[B1])
  
  If Len(strFilename) = 0 Then
     MsgBox "A filename is not specified in cell [B1] of the [Configuration] worksheet.", _
            vbExclamation Or vbOKOnly, _
            ThisWorkbook.Name
     blnContinue = False
  End If ' If Len(strFilename) = 0 Then
  
  If (blnContinue) Then
     Set objRange = Intersect(Selection, Worksheets("Project").Range("Body").Rows.Resize(, 1).Offset(, 9))
    
     If (objRange Is Nothing) Then
        MsgBox "No suitable cells in column [J] selected.", _
               vbExclamation Or vbOKOnly, _
               ThisWorkbook.Name
        blnContinue = False
     End If ' If objRange Is Nothing) Then
  End If ' If (blnContinue) Then
  
  If (blnContinue) Then
     Set objScripting_FileSystemObject = CreateObject("Scripting.FileSystemObject")
     blnContinue = Not (objScripting_FileSystemObject Is Nothing)
  End If ' If (blnContinue) Then

' Note: CreateTextFile Method - 1st parameter: [Filename]; 2nd: Overwrite [True|False]; 3rd: Unicode [True|False]

  If (blnContinue) Then
     Set objFile = objScripting_FileSystemObject.CreateTextFile(strFilename, True, False)
     blnContinue = Not (objFile Is Nothing)
  End If ' If (blnContinue) Then

  If (blnContinue) Then
     For Each objCell In objRange
         objFile.WriteLine (Join(Application.WorksheetFunction.Transpose( _
                                 Application.WorksheetFunction.Transpose( _
                                 Range(objCell.Offset(, -9), _
                                       objCell.Offset(, -1)).Value)), ","))
     Next objCell
     
     objFile.Close
     Set objFile = Nothing
     
     MsgBox "Number of rows processed: " & CStr(objRange.Rows.Count), _
            vbInformation Or vbOKOnly, _
            ThisWorkbook.Name
  End If ' If (blnContinue) Then
  
Exit_Q_28253299:

  On Error Resume Next

  If Not (objFile Is Nothing) Then
     objFile.Close
     Set objFile = Nothing
  End If ' If Not (objFile Is Nothing) Then
  
  Set objScripting_FileSystemObject = Nothing
  
  Set objCell = Nothing
  Set objRange = Nothing
  
  Worksheets("Project").Select
  
  [A1].Select
  
  Exit Sub
  
Err_Q_28253299:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description

  On Error Resume Next

  Beep

  MsgBox "Error #" & CStr(lngErr_Number) & _
         vbCrLf & vbLf & _
         strErr_Description, _
         vbExclamation Or vbOKOnly, _
         ThisWorkbook.Name

  Resume Exit_Q_28253299

End Sub

Open in new window


You did not respond to my question about whether an existing file should be overwritten, or not.  This code simply overwrites an existing file (with the same filename) if it exists.

I linked the code to the existing button, [Click], on the [Project] worksheet.

Finally, in respect of your original point 4...

4. Alert after work is done should show the number of rows that were processed and after clicking ok on the alert it should un-select the cells in Excel

After the message is removed from the screen (confirming with the [OK] button), at least one cell has to be selected; this I set to be cell [A1].


Thank you for your review & subsequent feedback, as necessary.

BFN,

fp.
Q-28253299.xlsm
0
aikimarkCommented:
This version of the code is getting the output path/file from the Configuration worksheet.
Option Explicit


Public Sub Q_28253299()
    Dim rngCR As Range
    Dim rngArea As Range
    Dim rngCell As Range
    Dim vData() As Variant
    Dim vVector() As Variant
    Dim strOut As String
    Dim lngLoop As Long
    Dim intFN As Integer
    intFN = FreeFile
    Open Worksheets("Configuration").Range("B1").Value For Output As #intFN
    Set rngCR = ActiveCell.CurrentRegion
    ReDim vVector(1 To rngCR.Columns.Count)
    For Each rngArea In Selection.Areas
        For Each rngCell In rngArea.Rows
            'Debug.Print Intersect(rngCR, rngCell.EntireRow).Address
            vData = Intersect(rngCR, rngCell.EntireRow).Value
            For lngLoop = 1 To UBound(vVector)
                vVector(lngLoop) = vData(1, lngLoop)
            Next
            strOut = Chr(34) & Join(vVector, """,""") & Chr(34)
            Print #intFN, strOut
        Next
    Next
    Close intFN
End Sub

Open in new window

0
breezbackAuthor Commented:
I couldn't run the samples correctly:

1. If no selection, the whole Body should be recorded to CSV
2. If selection, only the rows that have a cell selected should be recorded to CSV
0
[ fanpages ]IT Services ConsultantCommented:
2. If you select in Excel some of the cells in column j
Only the rows that have a selected cell should output to file. Multi-selection should be supported.

...

1. If no selection, the whole Body should be recorded to CSV

That is the first time you have stated that as a requirement.  No matter, I can amend the code I have already provided to accommodate.

2. If selection, only the rows that have a cell selected should be recorded to CSV

You asked to select cells in column [J].

I know that was working when I posted the code because that is exactly how I tested it.

Are you saying that selecting one or more cells in column [J], alongside those cells within the [Body] named range, & then using the [Click] button is not working for you?

Please confirm/clarify further, then I can make one change & post one revision to the workbook/code already provided.

Thank you.
0
aikimarkCommented:
@breezeback

please define "no selection"

This version of the routine now uses the named range, Body and will output all rows in the Body range if the active cell is not in the range.
Option Explicit


Public Sub Q_28253299()
    Dim rngCR As Range
    Dim rngArea As Range
    Dim rngCell As Range
    Dim vData() As Variant
    Dim vVector() As Variant
    Dim strOut As String
    Dim lngLoop As Long
    Dim intFN As Integer
    intFN = FreeFile
    Open Worksheets("Configuration").Range("B1").Value For Output As #intFN
    Set rngCR = Worksheets("Project").Range("Body")
    ReDim vVector(1 To rngCR.Columns.Count)
    If Intersect(Selection, rngCR) Is Nothing Then
        rngCR.Columns(1).Select
    End If
    For Each rngArea In Selection.Areas
        For Each rngCell In rngArea.Rows
            'Debug.Print Intersect(rngCR, rngCell.EntireRow).Address
            vData = Intersect(rngCR, rngCell.EntireRow).Value
            For lngLoop = 1 To UBound(vVector)
                vVector(lngLoop) = vData(1, lngLoop)
            Next
            strOut = Chr(34) & Join(vVector, """,""") & Chr(34)
            Print #intFN, strOut
        Next
    Next
    Close intFN
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
[ fanpages ]IT Services ConsultantCommented:
Please can you explain why you selected aikimark's proposal as the "solution"?

Did my suggestion not meet your requirements?

Please confirm/clarify further, then I can make one change & post one revision to the workbook/code already provided.

I have been waiting for the last five days for you to respond.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.