Page 6 of 8 FirstFirst ... 45678 LastLast
Results 51 to 60 of 75

Thread: vba Copy Paste Conditional to put remark 1 2 3 .. etc

  1. #51
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Spare post for later use
    Last edited by DocAElstein; 06-28-2020 at 07:28 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  2. #52
    if you can do it, Akan. so can I .... a spare post, i think I might need later

    Molly
    x
    Last edited by Molly Brennholz; 07-01-2020 at 12:19 PM.

  3. #53
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Macro Modification

    Hello, Need help regarding the macro
    Code:
    Sub STEP29()
    Dim wb1 As Workbook, wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
     Set wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
     Set wb2 = ThisWorkbook
     Set Ws1 = wb1.Worksheets.Item(1): Set Ws2 = wb2.Worksheets.Item(1)
    Dim arr1() As Variant, arr2() As Variant, arr3() As Variant
     Let arr1() = Ws1.Range("A1:K" & Ws1.Range("A1").CurrentRegion.Rows.Count & "").Value
     Let arr2() = Ws2.Range("A1").CurrentRegion.Value
     ReDim arr3(0 To UBound(arr2(), 1))
    Dim Cnt
        For Cnt = 2 To UBound(arr2(), 1)
        Dim Lc As Long: Let Lc = Ws2.Cells.Item(Cnt, Ws2.Cells.Columns.Count).End(xlToLeft).Column
         Let arr3(Cnt - 1) = Ws2.Range("A" & Cnt & ":" & CL(Lc + 1) & Cnt & "").Value
         Let arr3(Cnt - 1)(1, UBound(arr3(Cnt - 1), 2)) = UBound(arr3(Cnt - 1), 2) - 2
        Dim mtchRes As Variant
         Let mtchRes = Application.Match(arr2(Cnt, 2), Ws1.Range("B1:B" & UBound(arr1(), 1) & ""), 0)
            If IsError(mtchRes) Then
            ' a match was not found, so we do not need to remove the  1   2   3   etc...
            Else
            ' a match was found, so we need to remove the  1   2   3   etc...
            Dim Empt As Long
                For Empt = 3 To UBound(arr3(Cnt - 1), 2)
                 Let arr3(Cnt - 1)(1, Empt) = ""
                Next Empt
            End If
        '3c) Paste out row
        Let Ws2.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arr3(Cnt - 1)
        Next Cnt
    wb1.Close
    wb2.Save
    
                                                                                                                            
                                                                                                                            
                                                                                                                            
    End Sub
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    Public Function CL(ByVal lclm As Long) As String
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function

    Actually i converted that Alert..csv file to Alert..xls
    So I need the changes in the macro according to that
    So Plz have a look and help me in solving this problem Sir

  4. #54
    Hi,
    I am not quite sure what you are asking…
    ( Your macro above seems similar to some which I did for you ( https://excelfox.com/forum/showthrea...mark-1-2-3-etc ) )

    Probably all you would need to do is use the File name of the File that you are using
    Set wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..xls")
    But that is obvious. So possibly you are trying to ask something else.

    ( Of course, if you have been .Opening .csv text files with an Excel object, as in your macro above in post #1, ( https://excelfox.com/forum/showthrea...ll=1#post14144 ) then you may have got sometimes problems.
    But I am not going to make any attempt to explain that to you, since I can see from your recent posts here and elsewhere that many people have tried very hard to explain that all to you, and you still don’t seem to have understood anything !!! )
    Molly

  5. #55
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Sorry let me explain once again Molly Mam



    This macro is made for alert..csv file

    Code:
    Sub STEP29()
    Dim wb1 As Workbook, wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
     Set wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
     Set wb2 = ThisWorkbook
     Set Ws1 = wb1.Worksheets.Item(1): Set Ws2 = wb2.Worksheets.Item(1)
    Dim arr1() As Variant, arr2() As Variant, arr3() As Variant
     Let arr1() = Ws1.Range("A1:K" & Ws1.Range("A1").CurrentRegion.Rows.Count & "").Value
     Let arr2() = Ws2.Range("A1").CurrentRegion.Value
     ReDim arr3(0 To UBound(arr2(), 1))
    Dim Cnt
        For Cnt = 2 To UBound(arr2(), 1)
        Dim Lc As Long: Let Lc = Ws2.Cells.Item(Cnt, Ws2.Cells.Columns.Count).End(xlToLeft).Column
         Let arr3(Cnt - 1) = Ws2.Range("A" & Cnt & ":" & CL(Lc + 1) & Cnt & "").Value
         Let arr3(Cnt - 1)(1, UBound(arr3(Cnt - 1), 2)) = UBound(arr3(Cnt - 1), 2) - 2
        Dim mtchRes As Variant
         Let mtchRes = Application.Match(arr2(Cnt, 2), Ws1.Range("B1:B" & UBound(arr1(), 1) & ""), 0)
            If IsError(mtchRes) Then
            ' a match was not found, so we do not need to remove the  1   2   3   etc...
            Else
            ' a match was found, so we need to remove the  1   2   3   etc...
            Dim Empt As Long
                For Empt = 3 To UBound(arr3(Cnt - 1), 2)
                 Let arr3(Cnt - 1)(1, Empt) = ""
                Next Empt
            End If
        '3c) Paste out row
        Let Ws2.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arr3(Cnt - 1)
        Next Cnt
    wb1.Close
    wb2.Save
    
                                                                                                                            
                                                                                                                            
                                                                                                                            
    End Sub
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    Public Function CL(ByVal lclm As Long) As String
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function

    But now alert..csv file is replaced with alert.xls
    so the macro would be

    Code:
    Sub STEP29()
    Dim wb1 As Workbook, wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
     Set wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert.xls")
     Set wb2 = ThisWorkbook
     Set Ws1 = wb1.Worksheets.Item(1): Set Ws2 = wb2.Worksheets.Item(1)
    Dim arr1() As Variant, arr2() As Variant, arr3() As Variant
     Let arr1() = Ws1.Range("A1:K" & Ws1.Range("A1").CurrentRegion.Rows.Count & "").Value
     Let arr2() = Ws2.Range("A1").CurrentRegion.Value
     ReDim arr3(0 To UBound(arr2(), 1))
    Dim Cnt
        For Cnt = 2 To UBound(arr2(), 1)
        Dim Lc As Long: Let Lc = Ws2.Cells.Item(Cnt, Ws2.Cells.Columns.Count).End(xlToLeft).Column
         Let arr3(Cnt - 1) = Ws2.Range("A" & Cnt & ":" & CL(Lc + 1) & Cnt & "").Value
         Let arr3(Cnt - 1)(1, UBound(arr3(Cnt - 1), 2)) = UBound(arr3(Cnt - 1), 2) - 2
        Dim mtchRes As Variant
         Let mtchRes = Application.Match(arr2(Cnt, 2), Ws1.Range("B1:B" & UBound(arr1(), 1) & ""), 0)
            If IsError(mtchRes) Then
            ' a match was not found, so we do not need to remove the  1   2   3   etc...
            Else
            ' a match was found, so we need to remove the  1   2   3   etc...
            Dim Empt As Long
                For Empt = 3 To UBound(arr3(Cnt - 1), 2)
                 Let arr3(Cnt - 1)(1, Empt) = ""
                Next Empt
            End If
        '3c) Paste out row
        Let Ws2.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arr3(Cnt - 1)
        Next Cnt
    wb1.Close
    wb2.Save
    
                                                                                                                            
                                                                                                                            
                                                                                                                            
    End Sub
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    Public Function CL(ByVal lclm As Long) As String
        Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
    End Function


    Any more changes is required in this code then plz let me know Molly Mam

  6. #56
    I think I understood already what you are asking.
    I think you are still confused and mixed up because you have still not understood anything about the difference between Excel files and text files.
    You sometimes tell us that you understand. But all your questions suggest to us that you still have not understood anything at all.

    If I try to explain again, you will probably just get more confused or, more likely, you will not read or understand anything I tell you. So it will just waste all our time again.




    Quote Originally Posted by fixer View Post
    ...This macro is made for alert..csv file...
    Are you sure?
    I do not think so.
    Who made the macro for alert..csv file?

    I did not make any macro for you to work on a text ( .csv ) file.
    Who made this macro for you?
    It looks very similar to macros which I made for you. But all the macros I made for you were for Excel files. I never made any macros for you to work with text files




    If you are lucky,
    Code:
    Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert.xls")
    may sometimes do the same as what you want
    Code:
    Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
    to do.

    So if you are lucky, that will be the only change that you need.

    But it is very dangerous and stupid to ever do
    Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
    ( That code line is using the Excel object to .Open a text file. Excel is not really supposed to do that. Excel is mostly supposed to open Excel files. But Excel will allow you to try to open a text file. Excel will try to guess what to do. It may try to do what you want. Sometimes it may do different things. Many people have tried very hard to explain that in detail to you for 2 months already).


    That code line may sometimes do what you want. But there will probably always be problems.
    You seem to have decided not to want to know anything about such problems. So it may be impossible for anyone to really help you anymore.





    Remember one last very important thing:
    You are not the only person that understands nothing about the difference between Excel files and text files.
    Lots of people understand nothing about the difference between Excel files and text files.

    So if you continually cross post and ask the same question at different places, you will eventually find someone that will say to you.
    Yes, that is the only change needed .
    So you will be happy then. But it is the wrong answer.

    But that is your choice. You should do what you want to. You prefer a simple short answer, even if it is the wrong answer.

    It is nice to have different people in this world. Stay as you want to be. (You will never achieve your aim, unless your aim is to fail and get the wrong results sometimes).
    But you should stay as you want to be. The world would be very boring if we all were the same.


    Good luck in your future failures!

    Molly
    Last edited by Molly Brennholz; 07-01-2020 at 12:46 PM.

  7. #57
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    I made a Mistake & I corrected My Mistake
    I am not working with any .csv file
    & In Future I will never Ask any question related to .csv file
    Thnx Alot Molly Mam Doubts & Problem both are solved

  8. #58
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Thnx Alot For Providing the Great Info Doc Sir & Molly Mam
    Doc Sir Chill
    Every Code is working Perfectly
    I have no doubts in any Macro

  9. #59
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Macro Correction

    Moderator Notice: This and the next 4 posts were posted here in the wrong place. I have left the copies here since the linked post has been referrenced already. I have also copied the posts to the correct place:
    https://excelfox.com/forum/showthrea...ll=1#post14580





    Code:
    Sub STEP6()
        Dim Ws1 As Worksheet, Ws2 As Worksheet
        Dim Wb1 As Workbook, Wb2 As Workbook
        Dim r2&, lr&, i&
        
        Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
        Set Ws1 = Wb1.Worksheets.Item(1)
        Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Files\AlertCodes.xlsx")
        Set Ws2 = Wb2.Worksheets.Item(4)
        With Ws1
            lr = .Cells(.Rows.Count, "I").End(xlUp).Row
            For i = 2 To lr
                ' Reset r2
                r2 = 0
                ' Avoid error messages
                On Error Resume Next
                ' Try to get r2
                r2 = WorksheetFunction.Match(.Cells(i, "I"), Ws2.[B:B], 0)
                ' Restore error handling
                On Error GoTo 0
                ' Only set column K if r2 is valid
                If r2 > 0 Then
                    If Ws2.Cells(r2, "D") = ">" Then
                        .Cells(i, "K").Value = .Cells(i, "D").Value - 0.01 * .Cells(i, "D").Value
                    Else
                        .Cells(i, "K").Value = .Cells(i, "D").Value + 0.01 * .Cells(i, "D").Value
                    End If
                End If
            Next i
        End With
        Wb1.Save
        Wb1.Close
        Wb2.Close
        
    End Sub

    This codes calculate 1% of column of column D of 1.xls
    but what i wanted is instead of column D, it should calculate the data 1% with column E of AlertCodes.xlsx & add the calculated result with Column E of AlertCodes.xlsx and paste the result to same place where the current macro is putting,rest everything will be same

    Kindly note AlertCodes.xlsx doesn't have headers so keep a eye on the same

    Thnx for the Help

    https://eileenslounge.com/viewtopic....271443#p271443
    https://chandoo.org/forum/threads/vb...rection.44637/
    Last edited by DocAElstein; 07-14-2020 at 01:10 PM.

  10. #60
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Moderator Notice: This post was posted here in the wrong place. I have left the copy here since the linked post has been referrenced already. I have also copied this and the related reply posts to the correct place, starting here:
    https://excelfox.com/forum/showthrea...ll=1#post14580





    You almost had it right here: https://eileenslounge.com/viewtopic....6a1745#p271427
    You were close to correct.

    I try to explain again what Hans tried to explain ( I think you almost understood ):
    __With Ws1
    ………
    ……….
    …………………
    . Cells(i, "E") ……… .Cells(i, "E")
    __End With

    is almost =
    .....Ws1.Cells(i, "E") …… Ws1.Cells(i, "E")

    You want Ws2 ( for Alertcodes.xlsx ) , not Ws1

    Maybe like
    Code:
               Wtih Ws1
                    If Ws2.Cells(r2, "D") = ">" Then 'calculate the data 1% with column E of AlertCodes.xlsx & add the calculated result with Column E of AlertCodes.xlsx
                        .Cells(i, "K").Value = Ws2.Cells(i, "E").Value - 0.01 * Ws2.Cells(i, "E").Value
                    Else
                        .Cells(i, "K").Value = Ws2.Cells(i, "E").Value + 0.01 * Ws2.Cells(i, "E").Value
                    End If
               End With
    This will also be the same
    Code:
                    If Ws2.Cells(r2, "D") = ">" Then 'calculate the data 1% with column E of AlertCodes.xlsx & add the calculated result with Column E of AlertCodes.xlsx
                        Ws1.Cells(i, "K").Value = Ws2.Cells(i, "E").Value - 0.01 * Ws2.Cells(i, "E").Value
                    Else
                        Ws1.Cells(i, "K").Value = Ws2.Cells(i, "E").Value + 0.01 * Ws2.Cells(i, "E").Value
                    End If
    If this does not work, then you must explain again exactly what you want the macro to do.

    Ws2.Cells(i, "E").Value - 0.01 * Ws2.Cells(i, "E").Value
    and
    Ws2.Cells(i, "E").Value + 0.01 * Ws2.Cells(i, "E").Value
    is 'calculate the data 1% with column E of AlertCodes.xlsx & add the calculated result with Column E of AlertCodes.xlsx




    This was wrong:
    Ws2.Cells(i, "E").Value - 0.01 *.Cells(i, "E").Value
    and
    Ws2.Cells(i, "E").Value + 0.01 * .Cells(i, "E").Value
    It is 'calculate the data 1% with column E of AlertCodes.xlsx & add the calculated result with Column E of 1.xls
    It is the same as
    Ws2.Cells(i, "E").Value - 0.01 *Ws1.Cells(i, "E").Value
    and
    Ws2.Cells(i, "E").Value + 0.01 * Ws1.Cells(i, "E").Value



    ( I never use
    __ With
    __ End With

    because it confuses me.
    But lots of other people, like Hans do use it. Everyone writes codes a bit differently, because all VBA codes can be written in many ways. )





    Also
    Have you seen this ? : https://excelfox.com/forum/showthrea...4565#post14565
    Your macro , Sub STEP6() from here
    https://excelfox.com/forum/showthrea...ll=1#post14562
    and here
    https://eileenslounge.com/viewtopic....271385#p271385
    has the wrong Lr2
    Last edited by DocAElstein; 07-14-2020 at 01:12 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

Similar Threads

  1. Replies: 26
    Last Post: 09-26-2020, 05:56 PM
  2. VBA -- Copy/Paste across sheets
    By Rasm in forum Excel Help
    Replies: 4
    Last Post: 09-21-2012, 02:07 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •