ip: 3.144.235.141 DKs blog - Excel macros

DK's Blog

Connection strings examples
Ffmpeg
Linux administration
MySQL administration
Programming
       Android examples
       C# examples
       CSS examples
       Elastic Search
       Excel macros
       HTML/javascript examples
       MySQL examples
       Python
       Regular Expressions
       SQL (T-SQL) examples
       VB.NET examples
sublime text
Windows administration
WWW - reklame

Excel macros

Example of for loop inside excel sheet "sheetName"

 

Sub AddEmail()
  Dim w As Worksheet
  Set w = ActiveWorkbook.Worksheets("SheetName")

  For j = 1 To 1000
    If w.Cells(j, 2) <> "" Then w.Cells(j, 1) = w.Cells(j, 2) & "@mydomain.com"
    if IsNumeric(w.Cells(j, 1)) then w.Cells(j, 2) = 32 - (Log(w.Cells(j, 3)) / Log(2)) ''mask
  Next
End Sub

 

Save all sheets as separete CSV files and then uploda those CSV files to FTP server

If your Excel have 4 sheets "IRS, REPO, TZ, LIBOR" this will create 4 CSV files. You need c:\temp\

Sub Prebaci()

    Application.DisplayAlerts = False
    If Dir("C:\Temp\", vbDirectory) = "" Then MkDir "C:\Temp\"
    Application.ScreenUpdating = False
    strSavePath = "C:\Temp\"
    For Each sht In ActiveWorkbook.Sheets
        sht.Copy
        Set wbDest = ActiveWorkbook
        wbDest.SaveAs strSavePath & sht.Name, FileFormat:=xlCSV, CreateBackup:=False
        wbDest.Close 'Remove this if you don't want each book closed after saving.
    Next
    Application.DisplayAlerts = True
    
    Call FtpSend

End Sub

''slanje FTPjom samo tih 4 fileka !!!
Sub FtpSend()
    Dim vPath As String
    Dim vFile As String
    Dim vFTPServ As String
    Dim fNum As Long
    
    vPath = "c:\temp\"
    vFile = "IRS.csv REPO.csv TZ.csv LIBOR.csv"
    vFTPServ = "damir.globaldizajn.hr" 'your server
    
    ''"Mounting file command for ftp.exe
    fNum = FreeFile()
    Open vPath & "FtpComm.txt" For Output As #fNum
    Print #1, "USER login"
    Print #1, "password"
    Print #1, "lcd " & vPath
    Print #1, "mput " & vFile '' upload local filename to server file
    Print #1, "close" '' close connection
    Print #1, "quit" '' Quit ftp program
    Close
    
    Shell "ftp -n -i -g -s:" & vPath & "FtpComm.txt " & vFTPServ, vbNormalNoFocus

End Sub

 

Extended example from above, Save all sheets as separete CSV files and then uploda those CSV files to FTP server every 3 minutes (with timer no sleeping)

 

Private m_dtNextTime As Date
Private m_dtInterval As Date

Public Sub Start()
    Call Enable("00:03:00")
End Sub

Private Sub Enable(Interval As Date)
    StopTimer
    m_dtInterval = Interval
    StartTimer
End Sub

Private Sub StartTimer()
    m_dtNextTime = Now + m_dtInterval
    Application.OnTime m_dtNextTime, "MacroName"
End Sub

Private Sub MacroName()
    On Error GoTo ErrHandler:
    
    Call Prebaci

    '' Start timer again
    StartTimer
    Exit Sub
ErrHandler:
    MsgBox ("Greška u makrou")
End Sub

Public Sub Stop()
    On Error Resume Next '' Ignore errors
    Dim dtZero As Date
    If m_dtNextTime <> dtZero Then
        '' Stop timer if it is running
        Application.OnTime m_dtNextTime, "MacroName", , False
        m_dtNextTime = dtZero
    End If
    m_dtInterval = dtZero
End Sub

Private Sub Prebaci()
    Application.DisplayAlerts = False
    If Dir("C:\Temp\", vbDirectory) = "" Then MkDir "C:\Temp\"
    Application.ScreenUpdating = False
    strSavePath = "C:\Temp\"
    For Each sht In ActiveWorkbook.Sheets
        sht.Copy
        Set wbDest = ActiveWorkbook
        wbDest.SaveAs strSavePath & sht.Name, FileFormat:=xlCSV, CreateBackup:=False
        wbDest.Close 'Remove this if you don't want each book closed after saving.
    Next
    Application.DisplayAlerts = True
    
    Call FtpSend
End Sub

'send with FTPj only 4 files !!!
Private Sub FtpSend()
    Dim vPath As String
    Dim vFile As String
    Dim vFTPServ As String
    Dim fNum As Long
    
    vPath = "c:\temp\"
    vFile = "IRS.csv REPO.csv TZ.csv LIBOR.csv"
    vFTPServ = "www.volksbank.hr" 'your server
    
    'Mounting file command for ftp.exe
    fNum = FreeFile()
    Open vPath & "FtpComm.txt" For Output As #fNum
    Print #1, "USER login"
    Print #1, "password"
    Print #1, "lcd " & vPath
    Print #1, "mput " & vFile ' upload local filename to server file
    Print #1, "close" ' close connection
    Print #1, "quit" ' Quit ftp program
    Close
    
    Shell "ftp -n -i -g -s:" & vPath & "FtpComm.txt " & vFTPServ, vbNormalNoFocus
End Sub

 

Hide rows based on change of some cell

 

''Modul1:
Option Explicit
Global zadnja As Integer

Sub sakrijOvisnoOUnosu()
  Dim w As Worksheet
  Set w = ActiveWorkbook.Worksheets("List1")
  
  Dim r As Integer
  r = w.Cells(4, 14)
  
  ''MsgBox (r)
  
  If r > 10 And r <> zadnja Then
    Rows("19:1019").Select
    Selection.EntireRow.Hidden = False
    
    Rows(r + 19 & ":1019").Select
    Selection.EntireRow.Hidden = True
    zadnja = r
  
  End If
  
End Sub

''List1: (worksheet)
Private Sub Worksheet_Change(ByVal Target As Range)
    sakrijOvisnoOUnosu
    
End Sub

 

 

@2016