excel - Loop several independent expiration MSG functions -


this codes work perfect , shows message if of customers license has expired (one message customers). copy 12 times check separately in 12 sheets(months). ok. first question if there way check months (sheets) 1 code , show 1 message months, told me each customer expire month. , second in case no sheet have expire message inform me message no 1 expires in no sheet.

sub expire_date_1_15()      dim lrow long     dim lname string     dim lphone string     dim lresponse string     dim ldiff long     dim ldays long      lrow = 2   'start @ row 2     ldays = 40 'warning - number of days check expiration      sheets("1_15")         'check first 37 rows in column c         while lrow < 36              'only check expired certificate if value in column s not blank             if isdate(.range("r" & lrow))                 ldiff = .range("r" & lrow).value2 - date                 if (ldiff > 0) , (ldiff <= ldays)                     'get  names                     lname = .range("b" & lrow).value                     lnphone = .range("c" & lrow).value                     lresponse = lresponse & lname & " με αριθμό τηλ. " & lnphone & " λήγει σε " & ldiff & " μέρες." & chr(10)                 end if             end if              lrow = lrow + 1         wend         if cbool(len(lresponse)) _             msgbox "Τα συμβόλαια των παρακάτω πελατών για τον μήνα Μάρτιο 2015 : " & chr(10) & vbcrlf & lresponse, vbcritical, "ΕΝΗΜΕΡΩΣΗ ΛΗΞΗΣ ΣΥΜΒΟΛΑΙΩΝ"      end      call expire_date_2_15  end sub  sub expire_date_2_15()      dim lrow long     dim lname string     dim lphone string     dim lresponse string     dim ldiff long     dim ldays long      lrow = 2   'start @ row 2     ldays = 40 'warning - number of days check expiration      sheets("2_15")         'check first 37 rows in column c         while lrow < 36              'only check expired certificate if value in column s not blank             if isdate(.range("r" & lrow))                 ldiff = .range("r" & lrow).value2 - date                 if (ldiff > 0) , (ldiff <= ldays)                     'get  names                     lname = .range("b" & lrow).value                     lnphone = .range("c" & lrow).value                     lresponse = lresponse & lname & " με αριθμό τηλ. " & lnphone & " λήγει σε " & ldiff & " μέρες." & chr(10)                 end if             end if              lrow = lrow + 1         wend         if cbool(len(lresponse)) _             msgbox "Τα συμβόλαια των παρακάτω πελατών για τον μήνα Απρίλιο 2015 : " & chr(10) & vbcrlf & lresponse, vbcritical, "ΕΝΗΜΕΡΩΣΗ ΛΗΞΗΣ ΣΥΜΒΟΛΑΙΩΝ"      end      expire_date_Μάϊος_15  end sub 

as sub same each month except name of sheet, can re-use supplying call parameter. @ same time, relocate msgbox code month loop subroutine:

sub check_all_sheets()     dim month integer     dim n_expired integer      n_expired = 0     month = 1 12         ret = expire_date(month)         if len(ret) > 0             n_expired = n_expired + 1             msgbox ("expired: " & ret)         end if     next month     msgbox ("total licences expired: " & n_expired) end sub  function expire_date(month integer) string     dim lrow long     dim lname string     dim lphone string     dim lresponse string     dim ldiff long     dim ldays long     dim sh_name string      lrow = 2   'start @ row 2     ldays = 40 'warning - number of days check expiration     lresponse = ""      ' sh_name = cstr(month) & "_15"     sh_name = monthname(month) & "_15"  ' e.g. "may_15"     sheets(sh_name)         'check first 37 rows in column c         while lrow < 36             'only check expired certificate if value in column s not blank             if isdate(.range("r" & lrow))                 ldiff = .range("r" & lrow).value2 - date                 if (ldiff > 0) , (ldiff <= ldays)                     'get  names                     lname = .range("b" & lrow).value                     lnphone = .range("c" & lrow).value                     lresponse = lresponse & lname & " με αριθμό τηλ. " & lnphone & " λήγει σε " & ldiff & " μέρες." & chr(10)                 end if             end if             lrow = lrow + 1         wend     end     expire_date = lresponse end function 

btw, think code not checking first 37 rows rows 2..35.


Comments

Popular posts from this blog

asp.net mvc - SSO between MVCForum and Umbraco7 -

Python Tkinter keyboard using bind -

ubuntu - Selenium Node Not Connecting to Hub, Not Opening Port -