Someone help me Change value in txt file.

I have this code from another project of mine, I would like to adapt it to this project:

    Private  Sub TextFile_FindReplace()

    Dim y, i As Long, ii As Long
    If Me.ListBox1.ListIndex = -1 Then Exit Sub
    y = Split(x(Me.ListBox1.ListIndex), "|")
    For i = 0 To Me.ListBox1.ColumnCount - 1
        If Me("textbox"& i + 1) <> "" Then y(i) = Me("textbox"& i + 1)
    Next
    x(Me.ListBox1.ListIndex) = Join(y, "|")
    Open ThisWorkbook.Path & "\REGISTER\users.txt" For Output As #1
        Print #1, Join(x, vbNewLine);
    Close #1
    UserForm_Initialize
End sub

I would like to adapt this code above to the [BtnChangePass].

Explanation: I load the data into some textboxs with this code below:

Private Sub SearchLoginFileTXT()

Dim Registro() As String, blnFound As Boolean
Dim strLine As String
Dim f As Integer
Dim lngLine As Long, iD As Long
Dim strFileName As String
strFileName = ThisWorkbook.Path & "\REGISTER\users.txt"
    If TxtLogin.Text = "" And TxtChangeLogin.Text = "" And TxtCadLogin.Text = "" Then
        'Exit Sub
        'Call ClearFields
    Else
 f = FreeFile

Open strFileName For Input As #f
Do While Not EOF(f)
     lngLine = lngLine + 1
     Line Input #f, strLine
    Registro = Split(strLine, "|")
    blnFound = False
If Registro(2) = TxtLogin.Text Or Registro(2) = TxtChangeLogin.Text Or Registro(2) = TxtCadLogin.Text Then
                    Call LabelPosition
                        iD = Registro(0): TxtCheckCount.Text = Registro(0)
                        iD = Registro(0): TxtCheckID.Text = Registro(1)
                        iD = Registro(0): TxtCheckLogin.Text = Registro(2)
                        iD = Registro(0): TxtCheckName.Text = Registro(3)
                        iD = Registro(0): TxtCheckDateBirthday.Text = Registro(4)
                        iD = Registro(0): TxtCheckPassword.Text = Registro(5)
                        iD = Registro(0): TxtCheckStatus.Text = Registro(6)
                        iD = Registro(0): TxtLevel.Text = Registro(7)
                        blnFound = True
                        Close #f
                        Exit Sub

End If
    Loop
     Close #f
    If blnFound = False Then
        'Call LabelPosition2
        'MsgBox "Login Invalid", vbInformation
        'Cancel = True

    End If
     Close #f
End If

End Sub

I have to change this information when I click the button [BtnChangePass]

Thank you.

I am using code below which I am trying to change so as not to use .select

Selection.Select ' from active worksheet
    Selection.Copy
    Sheets("Purch Req").Select
    Range("A1").Select
    ActiveSheet.Paste

I have tried using this but there is no output to the other worksheet.

Dim src2Range As Range, dest2Range As Range

    Set src2Range = Selection 'source from selected range

    Set dest2Range = Sheets("Purch Req").Range("A1").Resize(src2Range.Rows.Count, src2Range.Columns.Count) ' destination range _
    'in Purch req worksheet

I read the xls file using this code:

private static DataSet GetDataSetFromExcelFilePath(string filePath)
{
    try
    {

        //Microsoft.Jet.OLEDB.4.0
        using (OleDbConnection oleDbConnection = new
        OleDbConnection(string.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0}; Extended Properties=\"Excel 8.0;Persist Security Info=False;HDR=No;IMEX=1;\"", filePath)))
        //OleDbConnection(string.Format("Provider=Microsoft.ACE.OLEDB.12.0;Data Source={0}; Extended Properties=\"Excel 8.0;Persist Security Info=False;HDR=No;IMEX=1\"", filePath)))
        //  using (OleDbConnection oleDbConnection = new
        //     OleDbConnection(string.Format("Provider=Microsoft.Jet.OLEDB.4.0;Data Source={0}; Extended Properties=\"Excel 8.0;Persist Security Info=False;HDR=No;IMEX=1\"", filePath)))
        {
            oleDbConnection.Open();

            DataTable schema = oleDbConnection.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, new object[] { null, null, null, "TABLE" });
            string sheetName = schema.Rows[0].Field<string>("TABLE_NAME");

            var adapter = new OleDbDataAdapter(string.Format("SELECT * FROM [{0}]", sheetName), oleDbConnection);
            var dataSet = new DataSet();
            adapter.Fill(dataSet, Path.GetFileName(filePath));

            return dataSet;
        }
    }
    catch (Exception ex)
    {       

        return null;
    }
}

Notice I have IMEX 1 set in the connection string so it reads all data as string yet I have a strange problem on one my client's machine where the AM / PM or full HH is completely ignored for time. Here is how the dataset is filled with the above code: https://gyazo.com/f45c29c42b5d1339ae1fe159be4caf76 where there is no distinction between AM and PM.

and here is how the actual data is in the excel: https://gyazo.com/caf91c165eb08e3110fd2c3b7d4b8c51

Please note it is not possible to change the excel format or structure. Preferably any changes possible has to be done in the code.

For references, if anybody wants to download the excel file to test here it is: https://www.dropbox.com/s/7824xh3ihlym9v9/test.xls?dl=0

One more thing the issue can be replicated when you set the Window's language to Norway as shown here: https://gyazo.com/d03b3056ed81e177076471a74058fdb7

My code is designed to open a file, copy the contents of the file, paste it into a working file with formulas. The formulas identify whether a row should be ignored. The code then goes through each row and copies over the row with "ignore" into a different tab and then deletes the row. The code then looks to see if "INV NOT FOUND", if the row has this designation it will then copy the row in to a new workbook and once it has gone through all of the rows, it closes and saves the new workbook. I have some files that are 5k+ rows and this takes far too long.

I am not really sure how else to code the loop.

Option Explicit

Sub RawData()
Dim CurrentDate As String
Dim PB As String
Dim ReturnsCheck As String
Dim Filename As String
Dim MyRange As String
Dim aWB As Workbook
Dim tWB As Workbook, newSheet As Worksheet
Dim MissingInvCount As Long
Dim rng As Range
Dim cell As Range
Dim search As String

Set tWB = ThisWorkbook

CurrentDate = Range("C6")
PB = Range("C8")

Application.EnableCancelKey = xlDisabled

Worksheets("data table").Visible = True

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    Worksheets("sort area").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
    Worksheets("pershing").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
    Worksheets("jpm").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
    Worksheets("gs").Visible = True
ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
    Worksheets("ms").Visible = True

End If

'Opens Raw file
    Workbooks.Open Filename:="G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\"& Range("PB") & "\"& Format(Range("CurrentDate"), "yyyy") & "\Raw Files\"& "Raw File - "& Range("PB") & ""& Format(Range("CurrentDate"), "mmddyy") & ".csv"


ActiveWorkbook.Activate
Set aWB = ActiveWorkbook

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    aWB.Activate
       Range("A1", Range("CZ"& Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("sort area").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
    aWB.Activate
       Range("A1", Range("U"& Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("pershing").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
    aWB.Activate
       Range("A1", Range("AD"& Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("jpm").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
    aWB.Activate
       Range("A1", Range("V"& Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("gs").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
    aWB.Activate
       Range("A1", Range("L"& Rows.Count).End(xlUp)).Copy
    tWB.Worksheets("ms").Range("A1").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If

'Closes Raw File w/o saving
    aWB.Close SaveChanges:=False

'Copy Formulas down
Dim Lastrow As Long

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    Worksheets("sort area").Activate
    Lastrow = Range("A"& Rows.Count).End(xlUp).Row
    Range("DB2:FN"& Lastrow).FillDown
ElseIf Range("PB") = "Pershing" Then
    Worksheets("pershing").Activate
    Lastrow = Range("B"& Rows.Count).End(xlUp).Row
    Range("W2:BO"& Lastrow).FillDown
ElseIf Range("PB") = "JPM" Then
    Worksheets("jpm").Activate
    Lastrow = Range("A"& Rows.Count).End(xlUp).Row
    Range("AI2:CU"& Lastrow).FillDown
ElseIf Range("PB") = "Goldman Sachs" Then
    Worksheets("gs").Activate
    Lastrow = Range("A"& Rows.Count).End(xlUp).Row
    Range("X2:CJ"& Lastrow).FillDown
ElseIf Range("PB") = "Morgan Stanley" Then
    Worksheets("ms").Activate
    Lastrow = Range("A"& Rows.Count).End(xlUp).Row
    Range("N2:BZ"& Lastrow).FillDown

End If

'Remove ignored lines & Idenitifies missing investments

Dim n As Integer
Dim nLastRow As Long
Dim nFirstRow As Long
Dim r As Range


    Set r = ActiveSheet.UsedRange
    nLastRow = Lastrow - 1
    nFirstRow = 2


Dim i As Long: i = 1

With ActiveSheet
    On Error Resume Next
    Application.ScreenUpdating = False

    If tWB.Worksheets("home").Range("PB") = "Citi" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "DB") = "IGNORE" Then
                .Cells(n, "DB").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "DB").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "Pershing" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "W") = "IGNORE" Then
                .Cells(n, "W").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "W").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "JPM" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "AI") = "IGNORE" Then
                .Cells(n, "AI").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "AI").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "Goldman Sachs" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "X") = "IGNORE" Then
                .Cells(n, "X").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "X").EntireRow.Delete
                i = i + 1
            End If
        Next

    ElseIf Range("PB") = "Morgan Stanley" Then

        For n = nLastRow To nFirstRow Step -1
            If .Cells(n, "N") = "IGNORE" Then
                .Cells(n, "N").EntireRow.Copy
                 Worksheets("ignore").Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
                .Cells(n, "N").EntireRow.Delete
                i = i + 1
            End If
        Next

    End If
End With

'Sort Ignore tab
Worksheets("ignore").Activate
Lastrow = Cells(Rows.Count, 2).End(xlUp).Row

If tWB.Worksheets("home").Range("PB") = "Citi" Then
    Range("A1:FG"& Lastrow).SORT key1:=Range("DE1:DE"& Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "Pershing" Then
    Range("A1:BO"& Lastrow).SORT key1:=Range("Z1:Z"& Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "JPM" Then
    Range("A1:CU"& Lastrow).SORT key1:=Range("AL1:AL"& Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "Goldman Sachs" Then
    Range("A1:CJ"& Lastrow).SORT key1:=Range("AA1:AA"& Lastrow), _
     order1:=xlAscending, Header:=xlNo

ElseIf Range("PB") = "Morgan Stanley" Then
    Range("A1:BZ"& Lastrow).SORT key1:=Range("Q1:Q"& Lastrow), _
     order1:=xlAscending, Header:=xlNo

End If

'Missing investments

If tWB.Worksheets("home").Range("PB") = "Citi" Then

Worksheets("sort area").Activate
Set rng = ActiveSheet.Range("DF1:DF"& Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("sort area").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "DF") = "INV NOT FOUND" Then
                    .Cells(n, "DF").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "DF").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "Pershing" Then

Worksheets("pershing").Activate
Set rng = ActiveSheet.Range("AA1:AA"& Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("pershing").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "AA") = "INV NOT FOUND" Then
                    .Cells(n, "AA").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "AA").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "JPM" Then

Worksheets("jpm").Activate
Set rng = ActiveSheet.Range("AM1:AM"& Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("jpm").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "AM") = "INV NOT FOUND" Then
                    .Cells(n, "AM").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "AM").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "Goldman Sachs" Then

Worksheets("gs").Activate
Set rng = ActiveSheet.Range("AB1:AB"& Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("gs").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "AB") = "INV NOT FOUND" Then
                    .Cells(n, "AB").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "AB").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If Range("PB") = "Morgan Stanley" Then

Worksheets("ms").Activate
Set rng = ActiveSheet.Range("R1:R"& Lastrow)
search = "INV NOT FOUND"
Set cell = rng.Find(What:=search, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If cell Is Nothing Then
        MsgBox ("There are no missing investments.")
    Else
        Set newSheet = ThisWorkbook.Sheets.Add
        Worksheets("ms").Activate
        i = 1

        With ActiveSheet
        On Error Resume Next
        Application.ScreenUpdating = False
            For n = nLastRow To nFirstRow Step -1
                If .Cells(n, "R") = "INV NOT FOUND" Then
                    .Cells(n, "R").EntireRow.Copy
                     newSheet.Cells(i, "A").PasteSpecial Paste:=xlPasteValues
                     Application.CutCopyMode = False
                     .Cells(n, "R").EntireRow.Delete
                    i = i + 1
                End If
            Next
        End With
        MissingInvCount = i - 1
    End If
End If

If MissingInvCount <> 0 Then
MsgBox ("There are "& MissingInvCount & " missing investments.")
End If

'Sort Missing Investments tab
If MissingInvCount <> 0 Then

    newSheet.Activate
    Lastrow = Cells(Rows.Count, 2).End(xlUp).Row

    If tWB.Worksheets("home").Range("PB") = "Citi" Then
        Range("A1:FN"& Lastrow).SORT key1:=Range("DC1:DC"& Lastrow), _
            order1:=xlAscending, Header:=xlNo
        Columns("DD:FN").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "Pershing" Then
        Range("A1:CI"& Lastrow).SORT key1:=Range("X1:X"& Lastrow), _
            order1:=xlAscending, Header:=xlNo
        Columns("Y:FN").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "JPM" Then
        Range("A1:CU"& Lastrow).SORT key1:=Range("AJ1:AJ"& Lastrow), _
            order1:=xlAscending, Header:=xlNo
        Columns("AK:CU").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "Goldman Sachs" Then
     Range("A1:CJ"& Lastrow).SORT key1:=Range("Y1:Y"& Lastrow), _
         order1:=xlAscending, Header:=xlNo
     Columns("Z:CJ").EntireColumn.Delete

    ElseIf tWB.Worksheets("home").Range("PB") = "Morgan Stanley" Then
     Range("A1:BZ"& Lastrow).SORT key1:=Range("O1:O"& Lastrow), _
         order1:=xlAscending, Header:=xlNo
     Columns("P:BZ").EntireColumn.Delete

    End If

    'Save flat file
    Dim strFullname As String
    Dim strFullname2 As String

    strFullname = "G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\"& Range("PB") & "\"& Format(Range("CurrentDate"), "yyyy") & "\Investments Pending Creation\"& Range("PB") & ""& Format(Range("CurrentDate"), "mmddyy") & ".csv"
    strFullname2 = "G:\CMG\DCM\Operations\Monthly Cycle\Monthly Transaction Upload\"& Range("PB") & "\"& Format(Range("CurrentDate"), "yyyy") & "\Ignored\"& Range("PB") & ""& Format(Range("CurrentDate"), "mmddyy") & ".csv"

    Application.DisplayAlerts = False

    ThisWorkbook.ActiveSheet.Move
    ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close

    ThisWorkbook.Worksheets("ignore").Copy
    ActiveWorkbook.SaveAs Filename:=strFullname2, FileFormat:=xlCSV, CreateBackup:=True
    ActiveWorkbook.Close

End If

Application.DisplayAlerts = True

Application.ScreenUpdating = True

Sheets("home").Activate

End Sub

i would like to code to finish in under 5 minutes if possible.

I would like to be able to select a text within a merged cell and change it, such as the text "1st" to "2nd" and then run a macro that would be able to find the text "1st" in other merged cells and change it to "2nd".

I'm not sure where to start. I've tried a replace statement, but that would require so much coding and complicated verbage.

This is what I have so far. Dim rng As Range rng = Range("A9:K10").Text rng.Text = Replace(rng, "1st", "2nd") End Sub

Using this VBA User Defined Function that yields a list of numbers that are in between a given set of parameter numbers. It works until the parameter numbers are greater than 29,999 in row 43. This is the UDF Code:

Function InBetween(MyFirst As Integer, MyLast As Integer)
Dim foo As String
Dim i As Long
foo = MyFirst + 1
For i = MyFirst + 2 To MyLast - 1
    foo = foo & ","& i
Next i
InBetween = foo
End Function

And I use the created =InBetween formula to return all numbers in between the parameter numbers. I'm also using a concatenate function to include the parameter numbers in the list. All of Column A and B are formatted the same.

What I am trying to do is select and modify a blank space.

For example, if you look at my excel file that I have posted, I have highlighted the cells of interest; If you look at column A you will notice attributes like (CON####) - CON1736, or CON1276, etc.

What I need to do it assign a string variable "TH" in the blank spaces (in column B).

To understand my goal please view attached image label final outcome.

Hope to hear back someone soon.

Cheers

I'm trying to speed up the trimming of a data sheet with about 5000 rows and 12 columns.

I've used a For Each Loop that works but always sets Excel into "not responding" for a while before it's done. Now I've done some research and found that With and Evaluate apparently works faster but I can't seem to get it working for me. It ends up deleting a bunch of my data and resorting the rest of it.

Here is my old code that works but is slow:

'trim everything in range
    Dim Rng As Range
    Set Rng = timeSheet.Range("A2:L"& lastCell)
    For Each cell In Rng
        If Not IsEmpty(cell.Value) Then
            cell.Value = Trim(cell)
        End If
    Next cell

This is my new code that is fast but destroys my data:

'trim everything in range 2.0
    Dim Rng As Range
    Set Rng = timeSheet.Range("A2:L"& lastCell)
    With Rng
        .Value = Evaluate("IF(ROW("& .Address & "),CLEAN(TRIM("& .Address & ")))")
    End With

Any idea what is wrong with my second code or other ideas on how I can speed up the first code?

Thanks!

I am having trouble creating some vba for a project that involves real time intervals. The sheet I originally created for this some years a ago has disappeared in a Windows update last year. For the life of me I can not recreate the code after all this time.

Column A has real time data that changes in milliseconds and I want to record data in that column at a set time interval eg 1 minute. What I am trying to do is - copy the data in Column A into column B after 1 minute. At the next 1 minute mark the new data in column A at that time is pasted into B and the previous saved in Column B is now pasted into Column C. At the next 1 minute the data in A goes to B, B goes to C and C goes to D etc.

Essentially, at every minute interval the recorded data creeps across the sheet one column at a time.

What I did find was a snippet of code I started with that may explain what I am trying to achieve.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Columns.Count <> 16 Then Exit Sub

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Range("b5:b30").Value = Range("b5:b30").Value
    Range("b5:b30").Value = Range("a5:a30").Value

    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Range("c5:c30").Value = Range("c5:c30").Value
    Range("c5:c30").Value = Range("b5:b30").Value

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

I am also hoping that there may be a simpler way to do this rather than writing a line for each column of the sheet.

Any help is appreciated

Someone help me Change value in txt file. I have this code from another project of mine, I would like to adapt it to this project:

    Private  Sub TextFile_FindReplace()

Dim y, i As Long, ii As Long
If Me.ListBox1.ListIndex = -1 Then Exit Sub
y = Split(x(Me.ListBox1.ListIndex), "|")
For i = 0 To Me.ListBox1.ColumnCount - 1
    If Me("textbox"& i + 1) <> "" Then y(i) = Me("textbox"& i + 1)
Next
x(Me.ListBox1.ListIndex) = Join(y, "|")
Open ThisWorkbook.Path & "\REGISTER\users.txt" For Output As #1
    Print #1, Join(x, vbNewLine);
Close #1
UserForm_Initialize
End sub

I would like to adapt this code above to the [BtnChangePass]. Explanation: I load the data into some textboxs with this code below:

Private Sub SearchLoginFileTXT()

Dim Registro() As String, blnFound As Boolean
Dim strLine As String
Dim f As Integer
Dim lngLine As Long, iD As Long
Dim strFileName As String
strFileName = ThisWorkbook.Path & "\REGISTER\users.txt"
    If TxtLogin.Text = "" And TxtChangeLogin.Text = "" And TxtCadLogin.Text = "" Then
        'Exit Sub
        'Call ClearFields
    Else
 f = FreeFile

Open strFileName For Input As #f
Do While Not EOF(f)
     lngLine = lngLine + 1
     Line Input #f, strLine
    Registro = Split(strLine, "|")
    blnFound = False
If Registro(2) = TxtLogin.Text Or Registro(2) = TxtChangeLogin.Text Or Registro(2) = TxtCadLogin.Text Then
                    Call LabelPosition
                        iD = Registro(0): TxtCheckCount.Text = Registro(0)
                        iD = Registro(0): TxtCheckID.Text = Registro(1)
                        iD = Registro(0): TxtCheckLogin.Text = Registro(2)
                        iD = Registro(0): TxtCheckName.Text = Registro(3)
                        iD = Registro(0): TxtCheckDateBirthday.Text = Registro(4)
                        iD = Registro(0): TxtCheckPassword.Text = Registro(5)
                        iD = Registro(0): TxtCheckStatus.Text = Registro(6)
                        iD = Registro(0): TxtLevel.Text = Registro(7)
                        blnFound = True
                        Close #f
                        Exit Sub

End If
    Loop
     Close #f
    If blnFound = False Then
        Call LabelPosition2
        'MsgBox "Login Invalid", vbInformation
        'Cancel = True

    End If
     Close #f
End If  
End Sub

I have to change this information when I click the button [BtnChangePass]

A part of my file consists in this:

Et  SF
1   4.4937
1   5.1257
1   5.2018
1   5.3755
1   5.741
1   5.9086
1   6.1399
1   6.2518
2   3.0424
2   3.2744
2   3.883
2   3.9595
2   3.9892
2   4.1603
2   4.2943
2   4.5118

And I would like to transpose this way:

Et     SF     SF      SF      SF      SF      SF      SF      SF
1   4.4937  5.1257  5.2018  5.3755  5.741   5.9086  6.1399  6.2518
2   3.0424  3.2744  3.883   3.9595  3.9892  4.1603  4.2943  4.5118

Is it possible to do this in excel. I tried the option OFFSET but I wasn't able to do this.

I'm a novice with VBA, and I'm seeking advice on how to best replace the values in the first table with values in the second table if the customer, PO #, and product name all match.

Note that, in reality, most of the values in Table 1 will not be included in Table 2.

Any suggestions? Thanks for the help!

Is there a library to do these calculations in python? For example dividing an amount by 10 to 10 “cells”? Thanks!

I have the following code with which i am successfully checking if i am connected to VPN from home to access company network folders.

Sub doit()
    If ConnectedToVPN Then
    ' run other code to access network folders and files...
    End if
End Sub


Function ConnectedToVPN() As Boolean
   Dim sComputer$, oWMIService, colItems, objItem

   ConnectedToVPN = False
   sComputer = "."

   Set oWMIService = GetObject("winmgmts:\\"& sComputer & "\root\CIMV2")
   Set colItems = oWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration", , 48)

    'Please check description of your VPN Connection by running command "ipconfig /all" on command-line.

    For Each objItem In colItems
        If (InStr(LCase(objItem.Description), "vpn")) Then
            ConnectedToVPN = objItem.IPEnabled
        End If
    Next objItem

    If (ConnectedToVPN) Then ConnectedToVPN = True

End Function

But if i am in company office and connected to intranet using LAN cable or office WIFI, i don't need to connect to VPN. This way, i cannot make my code work.

I tried the following but not giving me correct results:

• objItem.ServiceName
• objItem.DNSDomain

So what objItem properties would determine that i am already connected to intranet via either an Office Wifi or Office LAN. e.g. properties to determine State and type of Adapter to which i am connected i.e. whether Wifi, Ethernet etc?

Assume my Dec'2020 revenue is 1000. My total 2021 revenue forecast is 15000. I turned this into a monthly revenue increase evenly distributing the growth.

I set every month equals to their previous month PLUS a number(currently blank) throughout the 2021. Then I have a SUM() formula to total every month of 2021. I would then use goal seek to set the SUM to 15000 and change the value of the "number".

Results look like this

This has produced the desire result.

However, I am wondering if there's a faster way to do this? I would need this in a formula that I can simply drag over and get the results.

I have tried PMT formula with no luck.

I've designed a tool in excel for some clients that contains a sheet that acts as a user input form. On the sheet is an active-x combo bod, 8 shapes with assigned macros, and a range formatted with colour and borders to display data to the client.

For some reason this sheet is taking up around 3Mb of memory. I've made a copy and when deleting this sheet the file size drops to around 200Kb and everything is much smoother. I can't work out why this is the case.

So far I have tried:

• Unhiding all rows/columns and filling all cells in with "No fill"
• Eliminate excessive formatting tool (Inquire tab on the ribbon)
• Deleting all shapes/combo box one by one
• Removing borders and all text
• 'Demerging' all merged cells
• Removing unused styles
• Removing conditional formatting

Nothing seems to work. After all that I was sat with what was a completely blank and useless sheet, and still after deleting the sheet the file size dropped by 3MB even though I have 10 other sheets with a lot of data on.

Does anyone have any other suggestions as to why this might be happening and if so what can be done to rectify it? Could it be anything to do with my VBA or is excel throwing a wobbly?

As I have Excel vba code to get data from PDF form fields But It didn't work on MAC. So what is best way to get data from PDF files to excel (on MAC OS) i.e python, C++ or what is the best programming language?

I'm trying to setup a POS system for a friends Startup business. I need to copy fixed cells from the invoice and paste them into a table that archives the sales data. The cells aren't in the same row or column.

The cells that need to be copied are as follows (From "SalesSheet"): "E4", "E5", "C5", "C6", "F23", "F24", "F26"

These need to be copied and then pasted in that order into the next free row in the "SalesArchive" Sheet.

Ive searched the net from top to bottom but cant find an answer for this. Please help. Thanks In advance

I have % values on A1 to G1.In H1 I have multification formula.(A1*B1*C1*D1*E1*F1*G1).But I have only values in A2 to F2 and A3 to C3,A4 to E4.There is no pattern.How can I write a formula or vba code for get values for H1 ,H2,H3,H4 without removing or adding cells which contain values manually.

Steps, I have tried to retrieve data from column B to column DGood afternoon,

I have column B, with descriptions in Portuguese, row by row and column D with the translations in English: I'm trying to insert in column D the corresponding translation in Portuguese under each data row in English.

But I can't find any formula to do that, also I didn't find any question like this in the forum. The only nearest question about, is to insert a blank row between data rows with this formula =MOD(ROW(D2),2)=0 or with a filter adding series. And retrieving data with vlookup, as in the attached image.