Posts by bigfoot52277

Hey Adalaine,

The only other thing I see is the Cells reference in your If Cells.Font.Color I am still kinda new to VBA myself but shouldn't Cells be Cell ??

Adelaine,

I haven't been able to find any reference to excel font colors like you have shown above how are you getting the font color? You can use the below code to get the font color number then use that number in your if statement changing your if to if Cell.Font.ColorIndex = "Color index from below" Then

Function GetFontColor(ByVal Target As Range) As Integer
     GetFontColor = Target.Font.ColorIndex End Function

in an empty cell add the formula =GetFontColor(Cell with blue color you need) hopefully this will help you.

Hey Scott can't test but try this Left(pair, InStr(pair, "-")-1). As an example, pair = "Thisis-ATest", InStr(pair, "-")-1 = 6; Left(pair, 6) = Thisis if you are using the -1 to get the index before the "-" you dont need the Val unless there are other non-numeric characters if that is the case you can add the val back in easily. Val(Left(pair, InStr(pair, "-")-1)).

Hey Taylor,
If you are closing the form before trying to set the cell values textbox values no longer exist, I do not know if that is what is happening in your case though. I usually hide the form and unload on finish so that the values are always available. I also reference the form directly as in .Range("A2")..... = Form1.TextBox1.Value because as I understand it in a with loop the information from the form is not available without direct reference.

Sub Copy_by_keyword()
Dim srcFolder As String
Dim tgtFolder As String    
Dim sFilename As String    
Dim FilePath as String    
Dim c As Range    
Dim mRange As Range    
Dim bBad As Boolean    
Dim i as Long            


srcFolder = ("C:\Personal\Reports")
tgtFolder = ("D:\VBA\Trade\")
i = 0
Set mRange = ActiveSheet.Range("M10:M100").SpecialCells(xlConstants)    
For Each c In mRange          
    sFilename = Dir(srcFolder & "*" & c.Text & "*")          
    If sFilename = "" Then
        c.Interior.ColorIndex = 4
        bBad = False     'Here I used this to avoid overwriting but it does not respond'
    Else
        While sFilename <> ""
        FilePath = DIR(tgtFolder & sFilename)
        if FilePath = "" then
            FileCopy srcFolder & sFilename, tgtFolder & sFilename
            sFilename = Dir()
            c.Interior.ColorIndex = 6
         Else
             FileCopy srcFolder & sFilename, tgtFolder & sFilename & "( " & i & ")"
             sFilename = Dir()
             c.Interior.ColorIndex = 6
         Wend
Next c
If bBad Then MsgBox "Files not found"
End Sub

Sorry, was really tired. Try this.Again untested I am working on Linux and can't test right now.

If you have to keep both versions of a file you will have to somehow change the name of the Target file. You can add a check to catch a pre-existing file and add a qualifier, like (1) to the end of sFilename. Note this code is untested, your mileage may vary. Without being able to test you may have to manually change i = everytime you run this or maybe someone can offer a more eloquent solution.

Sub Copy_by_keyword()
Dim srcFolder As String
Dim tgtFolder As String    
Dim sFilename As String    
Dim FilePath as String    
Dim c As Range    
Dim mRange As Range    
Dim bBad As Boolean    
Dim i as Long          


srcFolder = ("C:\Personal\Reports")
tgtFolder = ("D:\VBA\Trade\")
i = 0
Set mRange = ActiveSheet.Range("M10:M100").SpecialCells(xlConstants)    
For Each c In mRange
         sFilename = Dir(srcFolder & "*" & c.Text & "*")
         If sFilename = "" Then
             c.Interior.ColorIndex = 4            
             bBad = False     'Here I used this to avoid overwriting but it does not respond'        
        Else            
            While sFilename <> ""                
            FilePath = DIR(tgtFolder & sFilename)                
        End If
         if FilePath = "" then
             FileCopy srcFolder & sFilename, tgtFolder & sFilename
         Else                    
              FileCopy srcFolder & sFilename, tgtFolder & sFilename & "( " & i & ")"
          sFilename = Dir()                
          c.Interior.ColorIndex = 6            
         Wend        
         End If    
Next c    
If bBad Then MsgBox "Files not found"      
End Sub

While .Value2 does maintain some number formatting between cells it does not carry cell formatting with it.

.Text gives you a string representing what is displayed on the screen for the cell. Using .Text is usually a bad idea because you could get ####

.Value2 gives you the underlying value of the cell (could be empty, string, error, number (double) or boolean)

.Value gives you the same as .Value2 except if the cell was formatted as currency or date it gives you a VBA currency (which may truncate decimal places) or VBA date.

Using .Value or .Text is usually a bad idea because you may not get the real value from the cell, and they are slower than .Value2

Learn more by reading about the Range Properties at https://docs.microsoft.com/en-…a/api/excel.range(object)

You can work around this with Sheet1.Range("BM2:BM").WrapText = False

Hey Ape, Best I can tell you are going to have to have access to the original image you can still set it in the left header or maybe I am missing something kinda new to VBA myself just trying to help out. You can check out https://docs.microsoft.com/en-…gesetup.leftheaderpicture maybe that will lead you in the right direction. I also see that .PageSetup.LeftHeader = "&G" has to be set in order for the image to be visible on the page. Also, it could be an option added in a later version of Excel I have seen several properties that are like that, not available before say Excel 2010.

Reference to: https://docs.microsoft.com/en-us/off...xcel.pagesetup, you can copy the page and contents over to a new sheet using:

Sub CopySheet()
     Dim thiswb As Workbook, wb As Workbook
     Dim newtab As Worksheet
     Set thiswb = ThisWorkbook
     Set wb = Workbooks.Add()
     With thiswb
        .Sheets("Sheet1").Copy After:=wb.Sheets(wb.Sheets.Count)
         Set newtab = wb.Sheets(wb.Sheets.Count - 1)
     End With
     With newtab
         sheetname = InputBox("Enter name of this Worksheet")
        .Name = sheetname
     End With
     With newtab.PageSetup
         .LeftHeader = Sheets("Sheet1").PageSetup.LeftHeader
         .CenterHeader = Sheets("Sheet1").PageSetup.CenterHeader
         .RightHeader = Sheets("Sheet1").PageSetup.RightHeader
         .LeftFooter = Sheets("Sheet1").PageSetup.LeftFooter
         .CenterFooter = Sheets("Sheet1").PageSetup.CenterFooter
         .RightFooter = Sheets("Sheet1").PageSetup.RightFooter
         .LeftHeaderPicture = Sheet("Sheet1").PageSet.LeftHeaderPicture
         'and so on and so on until all formatting is as sheet1
     End With
 End Sub

Untested because I am working on Linux right now and don't have access to Excel.

The likely cause is that the cell is formatted as text. So that when you try and enter a formula Excel tries to save you by quoting the "text" that you entered. Check the formatting under the number tab make sure it is set to general. If that doesn't work you can select the entire row, copy and paste special(ctrl+alt+v) into the next row and choose values and you should have your formula back.

If you are ok with the message box you can just [SIZE=12px]add [/SIZE][SIZE=12px]the units flag[/SIZE][SIZE=12px] to your firstVal, as per https://developers.google.com/maps/d...o#unit_systems if you change your [/SIZE][SIZE=12px]firstVal[/SIZE][SIZE=12px] to [/SIZE][SIZE=12px]"https://maps.googleapis.com/maps/api/distancematrix/json?units=imperial&origins=" it will return miles instead of meters.[/SIZE]

If you still want the information displayed in a cell as opposed to a msgbox you can change your TestDistance sub

Sub TestDistance()
    Worksheets("Name of Sheet").Range("Cell you want the Distance Put into(A2)").Value = GetDistance([DIST_FROM], [DIST_TO])
End Sub

Adding the below code should allow you to manipulate the image position and size. For more information regarding presentation shapes objects see:
https://docs.microsoft.com/en-…vba/api/powerpoint.shapes

Dim oSh As Shape
    For Each oSh In myslide.Shapes
        With oSh  
          If .Type = msoLinkedPicture _
             Or .Type = msoPicture Then
                 .Left = 100  
                 .Top = 100  
                 .Height = 100  
                 .Width = 200  
            End If
         End With  
  Next

Wilker,
Check into XMLHttpRequest. You can request a webpage and download a file or simply read it from VBA. The below code is untested because I am on Linux but give it a shot it should point you in the right direction.

Option Explicit


Sub Read_file ()


Dim http as Object
Dim oStream as Object
Dim url as String


set http = CreateObject("Microsoft.XMLHTTP")


url = "https://www.w3.org/TR/PNG\iso_8859-1.txt" 'just a random internet file I found for trying it out
http.Open "GET", url, False
html.Send
if http.Status = 200 then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.WriteText http.responseBody
    oStream.SaveToFile "C:\savefile.txt", 2 ' 1 = no overwrite, 2 = overwrite
    oStream.Close
End If


end Sub

Good evening,
I am creating a macro that allows the user to select sheets in a workbook via a userform activated with a custom ribbon tab. Locally I can make everything work. The issue I am having is distributing it, I was told to make the installation and use as simple as possible. I have tried to save as an add-in and programatically adding it. The add-in can't call the userform. I have tried saving as a personal workbook. The best solution I can find is to save the add-in on a remote server and loading it on workbook open. No matter how I go about it I cant get the custom tab to access the userform. I have attached the most complete version I have. Any help anyone could provide would be greatly appreciated. [ATTACH]n1212963[/ATTACH]