Posts by Binning

Re: Transfer data in another sheet

Hi Nick,

Could you possible upload an example sheet and I'll have a look?

Re: Multiple Text To Columns

apo,

thanks for this. excellent learning material. i eventually worked out how to do it just using arrays.

Sub Split_Numbers()
Dim temparray() As String
Dim i As Integer
Dim y As Integer
For y = 1 To Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To 4
On Error Resume Next
Range("A" & y).Replace i & ". ", ","
On Error GoTo 0
Next i
temparray = Split(Range("A" & y).Value, ",")
For i = 1 To UBound(temparray)
 Cells(y, i).Value = temparray(i)
 
Next i
Next y
End Sub

This assumes there is a max of 4 items in the list.

Re: Multiple Text To Columns

Hi Jindon,

I'll give that a try. In the mean time I built this which seems to do the job, although it is very untidy and confusing! (such are most of the macros I make).

Sub test()
Dim LN As Double
Dim x As String
Dim i As Double
Dim y As Double
Dim frstpos As Double
Dim sndpos As Double
Dim LR As Double




LR = Range("A" & Rows.Count).End(xlUp).Row
For y = 1 To LR
LN = 1
Again:
x = LN & "."
If InStr(Range("A" & y).Value, x) > 0 Then
LN = LN + 1
GoTo Again
Else
LN = LN - 1
End If
For i = 1 To LN
frstpos = InStr(Range("A" & y).Value, i & ".") + 2
sndpos = InStr(Range("A" & y).Value, i + 1 & ".")
If Not i = LN Then
Cells(y, i + 1).Value = Trim(Mid(Range("A" & y).Value, frstpos, sndpos - frstpos))
Else
Cells(y, i + 1).Value = Trim(Mid(Range("A" & y).Value, frstpos, Len(Range("A1").Value) - frstpos + 2))
End If
Next i
Next y
End Sub

Would you be able to explain what the With CreateObject("VBScript.RegExp") functionality allows? Can't say I'm familiar with it.

Re: Multiple Text To Columns

NBVC,

For some reason this is seperating everything with a space into a new field. I believe the "Treat consecutive delimiters as one" isn't working properly.

Jindon,

This works provided there is only one item per number. However, in some instances, it could be 1. CYUB2, CUB33 2. XFD3. In this case I would like "CYUB2, CUB33" in one field and "XFD3" in the other.

Any further suggestions?

Thanks

Hi there,

Some of the cells in my spreadsheet contain a list. For instance, cell A1 will have:

1. CYUP1 2. CYUP5 3.CYUP4

And cell A2 will have:

1. BDFD 2. DFJFD 3. DFJKE 4.DFDfd

Ideally I would like to split these out so that cell A1 contains CYUP1, Cell B1 contains CYUP5, Cell C1 contains CYUP4 etc.

The maximum amount of numbers in the list will be 4.

Thanks

Re: Macro (or formula) to Pull Data on Specific Date

Hi dlewis,

Would you be able to upload an example spreadsheet? It'll better help me solve your problem

Re: VBA Run Macro Based On Case

EDIT: Last post completely messed up and above method makes more sense.

Re: Retrieving data from pivot table

This assumes the values are in Columns A, B, C and D. Inserts new sheet with all the values.

Sub ReturnValues()
Dim vLetter As String
Dim LR As Double
Dim i As Double
Dim cSheet As String
With ActiveSheet
    .AutoFilterMode = False
    .FilterMode = False
End With
cSheet = ActiveSheet.Name
vLetter = InputBox("Enter Label A value.")
Sheets.Add(After:=Sheets(Sheets.Count)).Name = vLetter & " values"
Sheets(Sheets.Count).Select
Range("A1").Value = "Label C"
Sheets(cSheet).Select
LR = Range("C" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    If Left(Range("C" & i).Value, 1) = vLetter And IsNumeric(Right(Range("C" & i).Value, 1)) Then
    Range("C" & i).Copy Sheets(Sheets.Count).Range("A" & Rows.Count).End(xlUp).Offset(1)
    End If
Next i
Sheets(Sheets.Count).Select
End Sub

Re: Retrieving data from pivot table

Are the Label C values always going to be preceded by the Label A value?

Re: Copying rows based on differenec between two dates

Quote from royUK;715047

There's no point attaching an example workbook that is not representative of your actual workbook.

Hi Roy,

The original workbook contained information I didn't feel comfortable disclosing on here but it was similar to the example workbook I uploaded. I just wanted to see what people would do for it and then I would adjust the code accordingly. Sorry for the confusion!

Re: Copying rows based on differenec between two dates

Quote from royUK;714993

I didn't suggest adding new rows. The dates are your sheet are text not actual dates. To write efficient code then dates should be entered as dates. This really applies to using Excel in general as well - always enter dates as dates. The code could then automate AdvancedFilter and run in seconds.

What is this code referring to, there is no value in Column X

Code

xdate = Range("X" & i).Value

Sorry Roy I only uploaded an example sheet to see if someone could help, the sheet that I'm running the macro on is different. In my first post I specified that the two target columns were BS and X. I'd be interested in hearing how autofilter would help here? The main aim was to copy entries where there was a difference of more than 1 between action date and entry date. My first method involved inserting new rows, but seeing as the excel file was over 20000 rows large this took a long time. As such, I opted to add them at the bottom (because it doesn't matter where they're located, they can be filtered by account and date later).

Re: Copying rows based on differenec between two dates

I've managed to figure this out on my own to an extent. Inserting new rows would have cause too many issues because of the vast amount of data. As a result I just add it on to the bottom of all the data.

Sub CopyDates()
Dim LR As Long
Dim i As Long
Dim x As Long
Dim xdate As String
Dim bsdate As String
Application.ScreenUpdating = False
LR = Range("B" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
xdate = Range("X" & i).Value
bsdate = Range("BS" & i).Value
Range("BS" & i).Select
dateif = DateValue(xdate) - DateValue(bsdate) - 1
If dateif >= 1 Then
For x = 1 To dateif
Range("A" & i, Range("BS" & i)).Copy Range("A1").End(xlDown).Offset(1)
Range("BS" & Rows.Count).End(xlUp).Offset(0, 1).FormulaR1C1 = DateValue(bsdate) + x
Range("BS" & Rows.Count).End(xlUp).Offset(0, 2).FormulaR1C1 = x
Next x
End If


Next i


Application.ScreenUpdating = True


End sub

Re: Copying rows based on differenec between two dates

This has shown up horribly on here so here's an excel file to better demonstrate what I need

Hi there,

I'm going to make a horrible job at explaining this so bare with me.

We input information into our system on a certain day, however sometimes that information does not get actioned until a few days later. For instance, the information was put into the system on the 11th of April, however wasn't actioned until the 15th. What I need is something that creates copies for all the dates in between. I also need it to show how old each of the entries are as the days progress in a new column, as well as another column showing the dates. For example, where it currently shows

[ATTACHED DOCUMENT TO SHOW IN NEXT POST]

The action dates are in column "X" and the Entry Dates are in column "BS"

It's also worth noting that there are over 20,000 rows of data in this sheet, however not every row will need duplicate entries. For instance, if the entry date was the 11th and the Action date was the 12th then nothing needs to be done.

Thanks,
Binning

Re: Duplicate values in two ranges

Dim arrnames
arrnames = WorksheetFunction.Transpose(Sheets("New SOD Data").Range("C2", Range("C2").End(xlDown)))


With Sheets("Old_SOD_Data")
         'switch on AutoFilter if required
        If Not .AutoFilterMode Then .Range("A1").AutoFilter
         'use the array to filter the data
        .Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=Array(arrnames), Operator:=xlFilterValues
         'Select Cells to be deleted
        Sheets("Old_SOD_Data").Select
        Set rng = .Range("A2", Range("A2").End(xlDown)).SpecialCells(xlCellTypeVisible)
         'If nothing found then ignore the rest
        If rng.Rows.Count > 1000 Then                                                     'Values to be found normally 10-20, anything higher represents nothing found
        MsgBox "No duplicates to be deleted."
        .Range("A1").AutoFilter
        GoTo CopyData
        Else
        End If
        rng.Select
        'Display number to be deleted
        MsgBox Selection.Rows.Count & " existing entries to be deleted on SOD_Data."
        'Delete range
        rng.EntireRow.Delete
           'turn off autofilter
        .Range("A1").AutoFilter
End With


'Copies across New Data to Old Data tab
CopyData:
Sheets("New SOD Data").Select
Range("A2", Range("A2").End(xlDown).End(xlToRight)).Copy
Sheets("Old_SOD_Data").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Application.CutCopyMode = False

Thank you to royUK who was responsible for helping me use arrays in a previous post to identify duplicates on another sheet

Re: Duplicate values in two ranges

Quote from apo;713968

Hey.. I might be lazy.. but...

Attach a sample Workbook showing raw data and results desired...

Hi apo, you're not being lazy

I've managed to figure this out. I've just seperated the two ranges on to different sheets and ran a filter on the values in column C on one of them to delete them off the second range.

I hope that makes sense. If anyone wants the code then just ask.

Hi there,

I'm trying to develop a macro which looks to see if there are any duplicate values in two seperate ranges and then deletes off the duplicate in one of the them.

For example, I'll have two ranges (Range 1 and Range 2).

If any of the values from Column C in Range 1 exist within Column C in Range 2, then I would like the entire row containing that value on Range 2 to be deleted.

I have a feeling this can be done using Match which would identify the row number but I'm not sure how to integrate this into VBA. If it's of any help I've already identified and stored the two ranges.

Thanks,
Binning

Re: Problem copying data in loop function

Roy, I've realised my mistake. When I go into the 2nd phase of the loop the sheet with all the data is active, so szCharToFind isn't taken from Sheet1 anymore.

EDIT:

I also had to move the 'Next i' line up to just below the End With.

Re: Problem copying data in loop function

Here you go roy

Hi there,

In one of the sheets in my document (Sheet3) I have a list of names. The aim of the macro is to look at each name, and if that name exists in column A of another sheet then the macro will select all that data and copy it across. Here is the code:

Sub SelectCells()
    Dim szSheetToUse As String
    Dim szCharToFind As String * 1
    Dim iColumnToSearch As Integer
    Dim lFirstRow As Long, lLastRow As Long, lCurrRow As Long
    Dim szCurrCellValue As String
    Dim rgRangeToSelect As Range
    Dim LR As Long, i As Long
    
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
        
     '   Setup search parameters
    szSheetToUse = "Sheet3"
    szCharToFind = Range("A" & i).Value
    iColumnToSearch = 1 ' Column "A"
    lFirstRow = 1
    With Sheets(szSheetToUse)
         '   Find the last row with a value in the column to search
        lLastRow = .Rows.Count
        With .Cells(lLastRow, iColumnToSearch)
            If ("" = .Value) Then
                lLastRow = .End(xlUp).Row
            End If
        End With
         
         '   Find rows with the character to find in the column to search
        For lCurrRow = lFirstRow To lLastRow
             '   Get the value of the cell in the current row & the column to search
            szCurrCellValue = .Cells(lCurrRow, iColumnToSearch).Value
             
             '   If this values contains the character to find
            If (0 < Strings.InStr(1, szCurrCellValue, szCharToFind)) Then
                 '   Add the current row to the range to select
                If (rgRangeToSelect Is Nothing) Then
                    Set rgRangeToSelect = .Rows(lCurrRow)
                Else
                    Set rgRangeToSelect = Union(rgRangeToSelect, .Rows(lCurrRow))
                End If
            End If
        Next lCurrRow
         
        .Activate
    End With
     
     '   Copy all rows containing the character to find in the column to search
    rgRangeToSelect.Select
    Selection.Copy
    Sheets("Pasted values").Select
    Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Sheets("Sheet1").Select
    
Next i
End Sub

The problem I'm having is that when it moves to the next name and selects all the data on the other sheet containing that name, it also seems to select the last name as well. For instance, if the names were

Bob
Andrew
Megan

The first time it will select all the information containing bob and paste it on another sheet. However, when it looks for Andrew, it selects all the data containing Andrew and Bob, then pastes it on another sheet.

Any suggestions as to what is causing the problem? I feel like I've looked through everything.

Thanks,
Binning