• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 182
  • Last Modified:

excel-vba macro to update a sheet from external data


I am trying to setup a worksheet that :
- When a button is clicked, open a csv file and put it in an  area of the worksheet.
- colorize a worksheet (if empty then white else red)
- search for any mismatch between two area (the imported one  , and the original) and in case of mismatch highlight the offending line


I am looking for any information/tutorial needed to achieve this task...

Thanks !

0
quarky
Asked:
quarky
  • 4
  • 2
1 Solution
 
pauloaguiaCommented:
Could you please elaborate on points 2 and 3?
What do you mean "colorize a worksheet"? The whole worksheet? Just a range of cells?
And you mention an original area and an imported one. Are they in different sheets? Adjacent? When importing would the already existing area be liable to being overwritten?

I'd suggest one thing. You could record a macro with exactly what you want to do and then take a look at the code. That should be very informational.

If you have problems with the code, or even generating the code then you can allways post them here... and at least detail a bit more what you want done.

Hope this helps

Paulo
0
 
quarkyAuthor Commented:
Here is some code that reflects what i want to do.

The problem is that if i do not clear the area where i import my csv file, columns are added. I would like to overwrite the data, while keeping the formatting.
Since formatting is gone after re-import, I add all those edges to the active sheet.

Quarky




Private Sub UpdatePinButton_Click()
update_from_file
End Sub
   
Sub update_from_file()
   Dim Rep As String
   Dim File As Variant
   
   Dim c As Range
   Dim Error As Boolean
   Dim NewError As Boolean
'
   Sheets("pin connection").Select
   Set xlSheet = Worksheets("pin connection")
   
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    File = Application.GetOpenFilename("CSV Files (*.csv),*.csv,All files (*.*),*.*", 1, "Open pin list table")
   
    ' (canceled)
    If File = False Then
        Exit Sub
    End If
   
   
    MsgBox "Updating from : " & File
   
    Range("B:F").Clear
   
    With xlSheet.QueryTables.Add(Connection:="TEXT;" & File, Destination:=[B12])
        .Name = "pin"
        .AdjustColumnWidth = True
        .TextFilePlatform = xlWindows
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
    End With

' Cell coloration
    For Each c In Range("C13:F150")
       If c.Value <> "" Then
           c.Font.Bold = True
           c.Interior.Color = RGB(255, 0, 0)
       Else
           c.Font.Bold = False
           c.Interior.Color = RGB(255, 255, 255)
       End If
   Next
' Cell comparison
' Work on a column
   For Each c In Range("B13:B150")
       c.Offset(0, 5).Interior.Color = RGB(255, 255, 255)
    Next
   Error = False
   
   For Each c In Range("C14:C150")
       NewError = (c.Value <> c.Offset(0, 7)) Or (c.Offset(0, 1).Value <> c.Offset(0, 8)) _
       Or (c.Offset(0, 2).Value <> c.Offset(0, 9)) Or (c.Offset(0, 3).Value <> c.Offset(0, 10))
       
       If NewError Then
         c.Offset(0, 4).Interior.Color = RGB(0, 0, 0)
         Error = True
       End If
   Next
   
   Range("B13:F150").Select
   Selection.Columns.AutoFit
   
    Range("B4").Select
    Selection.Formula = "Last update :"
    Selection.Font.Bold = True
    Range("C4").Select
    Selection.Formula = "=text(now(),""dd mmm yyyy"")"
    Selection.Font.Bold = True
    Range("C5").Select
    Selection.Formula = "From " & File
    Selection.Font.Bold = True
   
   If Error = True Then
   MsgBox "A mismatch was found !"
   
   End If
  MakeBorder
    Range("A1").Select
End Sub
Sub MakeBorder()

    Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
izontal)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

End Sub

0
 
pauloaguiaCommented:
If basically you are creating the same query then you can do something like this:

...
   With xlSheet.QueryTables("pin")
       .Name = "pin"
       .Connection = "TEXT;" & File
       .AdjustColumnWidth = True
       .TextFilePlatform = xlWindows
...

Which mean you'll be refreshing the existing query not a new one. Try removing all those formatting code lines and you'll see formating sticks...

If you want to compare to whatever was there first then you can copy the old values to a temporary position before refreshing the query table, and deltete the temporary range in the end

Hope this helps

Paulo
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
pauloaguiaCommented:
quarky,

Why the B grade? I'd like to know what was missing from my answer so I can improve myself in the future.

Paulo
0
 
quarkyAuthor Commented:
I didn't know that good was not appropriate for an acceptable .
I thought that excellent was for exceptionnally good answers.

Sorry !


Quarky
0
 
pauloaguiaCommented:
It's ok. The description is not the best and experts have been trying for long now to make the site administration change that but the problem remains.

Anyway, quoting the mods:

"
Grading at Experts Exchange isn't like grading in school. It's a lot closer to the way the US Department of Agriculture grades meat; everything is Prime unless it isn't, in which case it's Choice or Select.

You should always give an A unless you have a good reason to grade less. For example, if you asked for more information and you didn't get it, or the expert only gave you a starting point and you still had to do most of the grunge work yourself, then a B is acceptable

A C grade is particularly unacceptable if the person simply posted their suggestion as a comment. After all, you are not obliged to accept a comment as the answer. You should always give an Expert a chance to raise a grade before giving a C.

Another thing you might want to consider is that a lot of our top experts check an asker's grading record. If they see that an asker habitually grades questions with "B"s or even "C"s they would be very reluctant to give their help. With your current record, you might find it difficult to get good and timely answers.
"

It doesn't mean you shouldn't give a B. There are plenty of cases where a B is an appropriate grade. Just explain why you're awarding a lesser grade.

This being your first time I won't mind if the grade remains like so. However if you ever have any problems in the future (want to delete a question, change a grade, etc) just post a 0 point question in the Community Support Topic Area with a link to that particular question stating your request.

Welcome to EE :)
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now