Parse data - Overwrite lines with updated data

Scifo

New Member
Joined
Apr 16, 2023
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi,
I have a macro, mostly from modifying and building on some help i got on this forum.
The Macro is designed to take a table of sales and then parse it into different sheets depending on the header.
In Column 1 I am changing the week number.
What I cannot manage to is adapt the macro so that if I enter a week number a second time it will overwrite the current data. (at the moment I can have two weeks 2')
I think this is a step beyond me at the moment..

VBA Code:
Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim icol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
 Range("B2:H150").Select
    Selection.replace What:="/", Replacement:=" ", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
         Selection.replace What:="Groups 1 to 5 Markets Project", Replacement:="Project A", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2

       
        
'Filtered Column Number
vcol = 2
'Worksheet to be split
Set ws = Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:M1"
titlerow = ws.Range(title).Cells(1).Row
icol = ws.Columns.Count
ws.Cells(1, icol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).clear
  For i = 2 To UBound(myarr)
         ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
 If Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then GoTo SHEET_EXISTS
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")

GoTo NEW_SHEET
SHEET_EXISTS:
       ws.Range("A" & titlerow & ":M" & lr).Offset(1).Copy
        Sheets(myarr(i) & "").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
NEW_SHEET:

      Sheets(myarr(i) & "").Columns.AutoFit
           If Sheet1.Range("r2").Value = 1 Then
    Application.Run ("Module2.Button4_Click")
    ElseIf Sheet1.Range("r2").Value < 1 Then
    End If
    
     

Next
'Remove filter
ws.AutoFilterMode = False
ws.Activate
End Sub

1710775770862.png
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,223,936
Messages
6,175,499
Members
452,650
Latest member
Tinfish

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top